home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
BASIC
/
2913.ZIP
/
QBSCR.ZIP
/
QBSCR.BAS
< prev
next >
Wrap
BASIC Source File
|
1989-09-05
|
128KB
|
3,104 lines
'┌────────────────────────────────────────────────────────────────────────┐
'│ │
'│ Q B S C R . B A S │
'│ │
'│ The QBSCR Screen Routines for QuickBASIC 4.0+ Programmers │
'│ Version 1.5 │
'│ │
'│ (C) Copyright 1989 by Tony Martin │
'│ │
'├────────────────────────────────────────────────────────────────────────┤
'│ │
'│ This source code is copyright 1989 by Tony Martin. You may change │
'│ it to suit your programming needs, but you may not distribute any │
'│ modified copies of the library itself. I retain all rights to the │
'│ source code and all library modules included with the QBSCR package, │
'│ as well as to the example programs. You may not remove this notice │
'│ from any copies of the library itself you distribute. │
'│ │
'│ This package is shareware. If you find it useful or use it in any │
'│ software you release, you are requested to send a donation of $15.00 │
'│ to: │
'│ │
'│ Tony Martin │
'│ 1611 Harvest Green Ct. │
'│ Reston, VA 22094 │
'│ │
'│ All registered users receive an "official" disk set containing the │
'│ latest verison of the QBSCR routines. For more information, see │
'│ the QBSCR documentation. │
'│ │
'├────────────────────────────────────────────────────────────────────────┤
'│ │
'│ Usage Instructions: │
'│ │
'│ These routines are designed to be used as a supplement to the │
'│ programs you write. They provide capabilities not included in the │
'│ QuickBASIC language. │
'│ │
'│ To use the routines, simply start QuickBASIC and load or begin │
'│ entering the code for your own program. Then load the file │
'│ QBSCR.BAS. With both programs in QuickBASIC at the same time, you │
'│ can call any of the QBSCR functions with a CALL statement. If you │
'│ prefer not to use CALL, then you must include the DECLARE statements │
'│ for the QBSCR routines in your own program. You can do this by │
'│ adding the line │
'│ │
'│ REM $Include: 'QBSCR.INC' │
'│ │
'│ at the beginning of your program. This file contains the necessary │
'│ DECLARE statements. │
'│ │
'│ When you compile your program from the environment, the QBSCR code │
'│ will be linked in automatically. │
'│ │
'│ An alternate method would be to use the Quick Library version of the │
'│ QBSCR routines. Make a Quick Library version of the Screen Routines │
'│ by loading this source code into QuickBASIC and selecting the "Make │
'│ Library" function from the Run menu. Then load the library with your │
'│ your program when you load it into QuickBASIC. Do this by starting │
'│ QuickBASIC with the command │
'│ │
'│ QB MYPROG /L QBSCR │
'│ │
'│ For detailed information, see the QBSCR documentation. │
'│ │
'└────────────────────────────────────────────────────────────────────────┘
'──────────────────────────────────────────────────────────────────────────
' DECLARE statements for all the QBSCR routines
'──────────────────────────────────────────────────────────────────────────
DECLARE FUNCTION BlockSize% (l%, r%, t%, b%)
DECLARE FUNCTION ColorChk ()
DECLARE FUNCTION GetBackground% (row%, col%)
DECLARE FUNCTION GetForeground% (row%, col%)
DECLARE FUNCTION GetString$ (leftCol!, row%, strLen%, foreColor%, backColor%)
DECLARE FUNCTION GetVideoSegment! ()
DECLARE FUNCTION MakeMenu% (choice$(), numOfChoices%, justify$, leftColumn!, rightColumn!, row%, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%)
DECLARE FUNCTION SubMenu% (choice$(), currentMenu%, numOfChoices%, justify$, leftColumn!, rightColumn!, row%, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%)
DECLARE FUNCTION ScreenBlank$ (delay)
DECLARE SUB Banner (st$, row%)
DECLARE SUB BlockRestore (l%, r%, t%, b%, scrArray%(), segment!)
DECLARE SUB BlockSave (l%, r%, t%, b%, scrArray%(), segment!)
DECLARE SUB BuildScreen (file$, mode%)
DECLARE SUB Center (st$, row%)
DECLARE SUB ClrScr (mode%, fillChar$)
DECLARE SUB DisplayEntry (entry$, qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, actionCode%)
DECLARE SUB GetScreen (file$)
DECLARE SUB PutScreen (file$)
DECLARE SUB MakeWindow (topRow!, leftCol!, botRow!, rightCol!, foreColor%, backColor%, windowType%, frameType%, shadowColor%, explodeType%, label$)
DECLARE SUB MultiMenu (menusArray$(), numEntries%(), menuTitles$(), justify$, marker$, shadowCode%, fg%, bg%, hfg%, hbg%, qfg%, qbg%, menuSelected%, menuEntrySelected%)
DECLARE SUB OffCenter (st$, row%, leftCol%, rightCol%)
DECLARE SUB QBPrint (st$, row%, col%, fore%, back%)
DECLARE SUB ScrnRestore (firstLine%, lastLine%, scrArray%(), segment)
DECLARE SUB ScrnSave (firstLine%, lastLine%, scrArray%(), segment)
DECLARE SUB Wipe (top%, bottom%, lft%, rght%, back%)
'──────────────────────────────────────────────────────────────────────────
' CONSTants required by the Screen Routines
'──────────────────────────────────────────────────────────────────────────
CONST FALSE = 0, TRUE = NOT FALSE
CONST LEFTARROWCODE = -99
CONST RIGHTARROWCODE = -98
SUB Banner (st$, row%) STATIC
'┌────────────────────────────────────────────────────────────────────────┐
'│ This subroutine displays a scrolling banner on any line of the │
'│ display screen. The scrolling effect is achieved through successive │
'│ calls to this subfunction. Each call shifts the string by 1 char- │
'│ acter and redisplays it. │
'│ │
'│ Parameters are as follows: │
'│ │
'│ st$ - The string containing the text to be scrolled. Must be │
'│ 80 characters or less. │
'│ row% - The row of the screen on which to scroll the text. Valid │
'│ range is 1 through 23. │
'└────────────────────────────────────────────────────────────────────────┘
'──────────────────────────────────────────────────────────────────────────
' Check to see if this is the first time Banner has been called
'──────────────────────────────────────────────────────────────────────────
temp$ = ""
IF NOT (bannerFlag) THEN
bannerFlag = -1
text$ = st$
END IF
'──────────────────────────────────────────────────────────────────────────
' Move each character in the banner string one space to the left
'──────────────────────────────────────────────────────────────────────────
FOR n = 1 TO LEN(text$) - 1
temp$ = temp$ + MID$(text$, n + 1, 1)
NEXT n
'──────────────────────────────────────────────────────────────────────────
' Set the last character in Temp$ to the first character of the string
'──────────────────────────────────────────────────────────────────────────
temp$ = temp$ + LEFT$(text$, 1)
'──────────────────────────────────────────────────────────────────────────
' Determine the column to display the new string on, centered
'──────────────────────────────────────────────────────────────────────────
text$ = temp$
x% = INT((80 - (LEN(text$))) / 2) + 1
'──────────────────────────────────────────────────────────────────────────
' Print the newly adjusted string
'──────────────────────────────────────────────────────────────────────────
LOCATE row%, x%, 0
PRINT text$;
END SUB
SUB BlockRestore (l%, r%, t%, b%, scrArray%(), segment!)
'┌──────────────────────────────────────────────────────────────────┐
'│ This subprogram will restore a rectanglar portion of the screen │
'│ that was saved using the QBSCR routine "BlockSave." The first │
'│ four parameters are the left, right, top, and bottom sides of │
'│ the rectangular area to restore. They should be the same as │
'│ the ones used when the area was saved. The scrArray% is an │
'│ integer array passed to this routine, that was originally used │
'│ to save the screen area. The segment parameter is the segment │
'│ of the screen memory to restore the saved info to. For this │
'│ parameter, simply use the QBSCR GetVideoSegment function. │
'└──────────────────────────────────────────────────────────────────┘
'────────────────────────────────────────────────────────────────────
' Determine where to start restoring in screen memory
'────────────────────────────────────────────────────────────────────
wdth% = 2 * (r% - l%) + 1
offset% = 160 * (t% - 1) + 2 * (l% - 1)
z% = 0
'────────────────────────────────────────────────────────────────────
' Set the memory segment to the screen memory address
'────────────────────────────────────────────────────────────────────
DEF SEG = segment
'────────────────────────────────────────────────────────────────────
' Restore the rectangular area of the screen by POKEing the stored
' screen display info into the display memory
'────────────────────────────────────────────────────────────────────
FOR x% = t% TO b%
FOR y% = 0 TO wdth%
POKE offset% + y%, scrArray%(z%)
z% = z% + 1
NEXT y%
offset% = offset% + 160
NEXT x%
'────────────────────────────────────────────────────────────────────
' Restore BASIC's default data segment
'────────────────────────────────────────────────────────────────────
DEF SEG
END SUB
SUB BlockSave (l%, r%, t%, b%, scrArray%(), segment!)
'┌──────────────────────────────────────────────────────────────────┐
'│ This subprogram will save a rectanglar portion of the screen │
'│ in an integer array. The first four parameters are the left, │
'│ right, top, and bottom sides of the rectangular area to │
'│ restore. The scrArray% is an integer array passed to this │
'│ routine in which to save the screen area. The segment parameter │
'│ is the segment of the screen memory to save from. For this │
'│ parameter, simply use the QBSCR GetVideoSegment function. │
'└──────────────────────────────────────────────────────────────────┘
'────────────────────────────────────────────────────────────────────
' Determine where to start saving in screen memory
'────────────────────────────────────────────────────────────────────
wdth% = 2 * (r% - l%) + 1
offset% = 160 * (t% - 1) + 2 * (l% - 1)
z% = 0
'────────────────────────────────────────────────────────────────────
' Set the memory segment to the screen memory address
'────────────────────────────────────────────────────────────────────
DEF SEG = segment
'────────────────────────────────────────────────────────────────────
' Save the rectangular area of the screen by PEEKing into the
' screen display memory at the right place
'────────────────────────────────────────────────────────────────────
FOR x% = t% TO b%
FOR y% = 0 TO wdth%
scrArray%(z%) = PEEK(offset% + y%)
z% = z% + 1
NEXT y%
offset% = offset% + 160
NEXT x%
'────────────────────────────────────────────────────────────────────
' Restore BASIC's default data segment
'────────────────────────────────────────────────────────────────────
DEF SEG
END SUB
FUNCTION BlockSize% (l%, r%, t%, b%)
'┌──────────────────────────────────────────────────────────────────┐
'│ This function will calculate the number of elements required │
'│ for an array used to save a rectangular area of the screen. │
'│ The four parameters are the left, right, top, and bottom values │
'│ of the rectangular area of the screen. Use the function right │
'│ inside the DIM statement, like this: │
'│ DIM scrArray%(BlockSize%(1, 1, 10, 20)) │
'└──────────────────────────────────────────────────────────────────┘
BlockSize% = ((r% - l% + 1) * (b% - t% + 1)) * 2
END FUNCTION
SUB BuildScreen (file$, mode%)
'┌────────────────────────────────────────────────────────────────────────┐
'│ This routine allows you to place on the screen a predefined display │
'│ that was created with Screen Builder. It will place the display on │
'│ the screen in any of sixteen different ways. Note that the methods │
'│ of displaying the screen are identical to the methods used in the │
'│ ClrScr routine. Some code differences will be apparent for obvious │
'│ reasons. │
'│ │
'│ Parameters are as follows: │
'│ │
'│ file$ - The name of the screen file that was saved using the │
'│ Screen Builder program. │
'│ mode% - The method to use when placing the screen on the display. │
'└────────────────────────────────────────────────────────────────────────┘
'──────────────────────────────────────────────────────────────────────────
' The delay local variable is used here for dummy loops that create a
' very brief pauses of execution at points in the routine that need it,
' particularly in the vertical motion. Change this value to suit the
' speed of your machine, or make it 0 to get rid of it.
'──────────────────────────────────────────────────────────────────────────
delay = 10
COLOR f%, b%
'──────────────────────────────────────────────────────────────────────────
' Load the screen file into an array for later access
'──────────────────────────────────────────────────────────────────────────
DIM scrArray(4000) AS STRING * 1
DIM sArray%(4000)
DEF SEG = VARSEG(scrArray(0))
BLOAD file$, VARPTR(scrArray(0))
DEF SEG
'──────────────────────────────────────────────────────────────────────────
' Convert the array to one that runs much faster
'──────────────────────────────────────────────────────────────────────────
FOR x% = 0 TO 3999
sArray%(x%) = ASC(scrArray(x%))
NEXT x%
'──────────────────────────────────────────────────────────────────────────
' Determine the memory segment of the video display for all direct screen
' writes and save it in vidSeg
'──────────────────────────────────────────────────────────────────────────
vidSeg = GetVideoSegment
SELECT CASE mode%
CASE 0 ' ─ Horizontal build, middle out ────────────────────────────────
y% = 12
FOR x% = 13 TO 1 STEP -1
FOR d = 1 TO delay: NEXT d
y% = y% + 1
xOffSet% = (x% - 1) * 160
yOffSet% = (y% - 1) * 160
DEF SEG = vidSeg
FOR a% = 0 TO 159
POKE xOffSet% + a%, sArray%(xOffSet% + a%)
POKE yOffSet% + a%, sArray%(yOffSet% + a%)
NEXT a%
DEF SEG
NEXT x%
CASE 1 ' ─ Horizontal build, ends in ───────────────────────────────────
y% = 26
FOR x% = 1 TO 13
FOR d = 1 TO delay: NEXT d ' Delay loop - change delay above to
y% = y% - 1 ' regulate speed
xOffSet% = (x% - 1) * 160
yOffSet% = (y% - 1) * 160
DEF SEG = vidSeg
FOR a% = 0 TO 159
POKE xOffSet% + a%, sArray%(xOffSet% + a%)
POKE yOffSet% + a%, sArray%(yOffSet% + a%)
NEXT a%
DEF SEG
NEXT x%
CASE 2 ' ─ Vertical build, middle out ───────────────────────────────────
y% = 39
FOR x% = 39 TO 0 STEP -1
y% = y% + 1
DEF SEG = vidSeg
FOR i% = 1 TO 25
xOffSet% = ((i% - 1) * 160) + (x% * 2)
yOffSet% = ((i% - 1) * 160) + (y% * 2)
POKE xOffSet%, sArray%(xOffSet%): POKE xOffSet% + 1, sArray%(xOffSet% + 1)
POKE yOffSet%, sArray%(yOffSet%): POKE yOffSet% + 1, sArray%(yOffSet% + 1)
NEXT i%
DEF SEG
FOR d = 1 TO delay: NEXT d
NEXT x%
CASE 3 ' ─ Vertical build, ends in ──────────────────────────────────────
y% = 80
FOR x% = 0 TO 40
y% = y% - 1
DEF SEG = vidSeg
FOR i% = 1 TO 25
xOffSet% = ((i% - 1) * 160) + (x% * 2)
yOffSet% = ((i% - 1) * 160) + (y% * 2)
POKE xOffSet%, sArray%(xOffSet%): POKE xOffSet% + 1, sArray%(xOffSet% + 1)
POKE yOffSet%, sArray%(yOffSet%): POKE yOffSet% + 1, sArray%(yOffSet% + 1)
NEXT i%
DEF SEG
FOR d = 1 TO delay: NEXT d
NEXT x%
CASE 4 ' ─ Left to right screen build ───────────────────────────────────
FOR x% = 0 TO 79
DEF SEG = vidSeg
FOR i% = 1 TO 25
xOffSet% = ((i% - 1) * 160) + (x% * 2)
POKE xOffSet%, sArray%(xOffSet%): POKE xOffSet% + 1, sArray%(xOffSet% + 1)
NEXT i%
DEF SEG
FOR d = 1 TO delay: NEXT d
NEXT x%
CASE 5 ' ─ Right to left screen build ───────────────────────────────────
FOR x% = 79 TO 0 STEP -1
DEF SEG = vidSeg
FOR i% = 1 TO 25
xOffSet% = ((i% - 1) * 160) + (x% * 2)
POKE xOffSet%, sArray%(xOffSet%): POKE xOffSet% + 1, sArray%(xOffSet% + 1)
NEXT i%
DEF SEG
FOR d = 1 TO delay: NEXT d
NEXT x%
CASE 6 ' ─ All sides in to center ───────────────────────────────────────
y% = 25
FOR x% = 0 TO 13
y% = y% - 1
topOffSet% = x% * 160
botOffSet% = y% * 160
DEF SEG = vidSeg
' Top-most row
FOR j% = (x% * 3) TO (y% * 3) + 7
POKE topOffSet% + (j% * 2), sArray%(topOffSet% + (j% * 2))
POKE topOffSet% + (j% * 2) + 1, sArray%(topOffSet% + (j% * 2) + 1)
NEXT j%
' Left and right sides
FOR j% = x% TO y%
FOR i% = 0 TO 5
POKE (j% * 160) + (x% * 6) + i%, sArray%((j% * 160) + (x% * 6) + i%)
POKE (j% * 160) + (y% * 6) + 10 + i%, sArray%((j% * 160) + (y% * 6) + 10 + i%)
NEXT i%
NEXT j%
' Bottom-most row
FOR j% = (x% * 3) TO (y% * 3) + 7
POKE botOffSet% + (j% * 2), sArray%(botOffSet% + (j% * 2))
POKE botOffSet% + (j% * 2) + 1, sArray%(botOffSet% + (j% * 2) + 1)
NEXT j%
DEF SEG
NEXT x%
CASE 7 ' ─ All sides out from center ────────────────────────────────────
y% = 11
FOR x% = 12 TO 0 STEP -1
y% = y% + 1
topOffSet% = x% * 160
botOffSet% = y% * 160
DEF SEG = vidSeg
' Top-most row
FOR j% = (x% * 3) TO (y% * 3) + 7
POKE topOffSet% + (j% * 2), sArray%(topOffSet% + (j% * 2))
POKE topOffSet% + (j% * 2) + 1, sArray%(topOffSet% + (j% * 2) + 1)
NEXT j%
' Left and right sides
FOR j% = x% TO y%
FOR i% = 0 TO 5
POKE (j% * 160) + (x% * 6) + i%, sArray%((j% * 160) + (x% * 6) + i%)
POKE (j% * 160) + (y% * 6) + 10 + i%, sArray%((j% * 160) + (y% * 6) + 10 + i%)
NEXT i%
NEXT j%
' Bottom-most row
FOR j% = (x% * 3) TO (y% * 3) + 7
POKE botOffSet% + (j% * 2), sArray%(botOffSet% + (j% * 2))
POKE botOffSet% + (j% * 2) + 1, sArray%(botOffSet% + (j% * 2) + 1)
NEXT j%
DEF SEG
NEXT x%
CASE 8 ' ─ Vertical split - left down, right up ─────────────────────────
y% = 26
FOR x% = 1 TO 25
FOR d = 1 TO delay: NEXT d
y% = y% - 1
DEF SEG = vidSeg
offset% = (x% - 1) * 160
FOR i% = 0 TO 79
POKE offset% + i%, sArray%(offset% + i%)
NEXT i%
offset% = (y% - 1) * 160
FOR i% = 80 TO 159
POKE offset% + i%, sArray%(offset% + i%)
NEXT i%
DEF SEG
NEXT x%
CASE 9 ' ─ Horizontal split - top right to left, bottom left to right ───
y% = 80
FOR x% = 0 TO 79
y% = y% - 1
DEF SEG = vidSeg
FOR i% = 1 TO 12
offset% = ((i% - 1) * 160) + (x% * 2)
POKE offset%, sArray%(offset%): POKE offset% + 1, sArray%(offset% + 1)
NEXT i%
FOR i% = 13 TO 25
offset% = ((i% - 1) * 160) + (y% * 2)
POKE offset%, sArray%(offset%): POKE offset% + 1, sArray%(offset% + 1)
NEXT i%
DEF SEG
NEXT x%
CASE 10 ' ─ Spiral inward ────────────────────────────────────────────────
FOR x% = 1 TO 25 ' │
offset% = (x% - 1) * 160 ' │
DEF SEG = vidSeg ' │
FOR y% = 0 TO 31 ' │
POKE offset% + y%, sArray%(offset% + y%) '
NEXT y%
DEF SEG
NEXT x%
offset% = 19 * 160 ' │
FOR x% = 16 TO 79 ' │
DEF SEG = vidSeg ' │
FOR y% = 0 TO 5 ' └────────────
POKE 3040 + (x% * 2) + (y% * 160), sArray%(3040 + (x% * 2) + (y% * 160))
POKE 3041 + (x% * 2) + (y% * 160), sArray%(3041 + (x% * 2) + (y% * 160))
NEXT y%
DEF SEG
NEXT x%
FOR x% = 19 TO 1 STEP -1 ' │
offset% = (x% - 1) * 160 + 127 ' │ │
DEF SEG = vidSeg ' │ │
FOR y% = 0 TO 32 ' │ │
POKE offset% + y%, sArray%(offset% + y%) ' └────────────┘
NEXT y%
DEF SEG
NEXT x%
' │ ──────────┐
FOR x% = 63 TO 16 STEP -1 ' │ │
DEF SEG = vidSeg ' │ │
FOR y% = 0 TO 5 ' └────────────┘
POKE 1 + (x% * 2) + (y% * 160), sArray%(1 + (x% * 2) + (y% * 160))
POKE (x% * 2) + (y% * 160), sArray%((x% * 2) + (y% * 160))
NEXT y%
DEF SEG
NEXT x%
FOR x% = 7 TO 19
offset% = (x% - 1) * 160 + 32 ' │ ┌──────────┐
DEF SEG = vidSeg ' │ │ │
FOR y% = 0 TO 31 ' │ │ │
POKE offset% + y%, sArray%(offset% + y%) ' │ │
NEXT y% ' └────────────┘
DEF SEG
NEXT x%
offset% = 19 * 160 ' │ ┌──────────┐
FOR x% = 32 TO 63 ' │ │ │
DEF SEG = vidSeg ' │ └──────── │
FOR y% = 0 TO 5 ' └────────────┘
POKE 2240 + (x% * 2) + (y% * 160), sArray%(2240 + (x% * 2) + (y% * 160))
POKE 2241 + (x% * 2) + (y% * 160), sArray%(2241 + (x% * 2) + (y% * 160))
NEXT y%
DEF SEG
NEXT x%
FOR x% = 14 TO 6 STEP -1 ' │ ┌──────────┐
offset% = (x% - 1) * 160 + 95 ' │ │ │
DEF SEG = vidSeg ' │ │ │ │
FOR y% = 1 TO 31 ' │ └────────┘ │
POKE offset% + y%, sArray%(offset% + y%) ' └────────────┘
NEXT y%
DEF SEG
NEXT x%
offset% = 6 * 160 ' │ ┌──────────┐
FOR x% = 47 TO 32 STEP -1 ' │ │ ──────┐ │
DEF SEG = vidSeg ' │ └────────┘ │
FOR y% = 0 TO 5 ' └────────────┘
POKE offset% + 1 + (x% * 2) + (y% * 160), sArray%(offset% + 1 + (x% * 2) + (y% * 160))
POKE offset% + (x% * 2) + (y% * 160), sArray%(offset% + (x% * 2) + (y% * 160))
NEXT y%
DEF SEG
NEXT x%
FOR x% = 13 TO 14
offset% = (x% - 1) * 160 + 64 ' │ ┌──────────┐
DEF SEG = vidSeg ' │ │ ┌────┐ │
FOR y% = 0 TO 31 ' │ │ │ │
POKE offset% + y%, sArray%(offset% + y%) ' │ └────────┘ │
NEXT y% ' └────────────┘
DEF SEG
NEXT x%
CASE 11 ' ─ Top to bottom ────────────────────────────────────────────────
FOR x% = 1 TO 25
FOR d = 1 TO delay: NEXT d
DEF SEG = vidSeg
offset% = (x% - 1) * 160
FOR i% = 0 TO 159
POKE offset% + i%, sArray%(offset% + i%)
NEXT i%
DEF SEG
NEXT x%
CASE 12 ' ─ Bottom to top ────────────────────────────────────────────────
FOR x% = 25 TO 1 STEP -1
FOR d = 1 TO delay: NEXT d
DEF SEG = vidSeg
offset% = (x% - 1) * 160
FOR i% = 0 TO 159
POKE offset% + i%, sArray%(offset% + i%)
NEXT i%
DEF SEG
NEXT x%
CASE 13 ' ─ Upper-left corner to lower-right ────────────────────────────
FOR x% = 1 TO 25
' The horizontal portion...
offset% = (x% - 1) * 160
DEF SEG = vidSeg
FOR i% = offset% TO offset% + (x% * 6)
POKE i%, sArray%(i%)
NEXT i%
' ...and the vertical portion.
FOR y% = 1 TO x%
offset% = ((y% - 1) * 160) + (x% * 6)
DEF SEG = vidSeg
FOR j% = 0 TO 5
POKE offset% + j%, sArray%(offset% + j%)
NEXT j%
DEF SEG
NEXT y%
NEXT x%
' Take care of the remaining two columns
FOR y% = 1 TO 25
offset% = ((y% - 1) * 160) + 155
DEF SEG = vidSeg
FOR j% = 0 TO 4
POKE offset% + j%, sArray%(offset% + j%)
NEXT j%
DEF SEG
NEXT y%
CASE 14 ' ─ Lower-right corner to upper-left ────────────────────────────
' Take care of the last two columns
FOR y% = 1 TO 25
offset% = ((y% - 1) * 160) + 155
DEF SEG = vidSeg
FOR j% = 0 TO 4
POKE offset% + j%, sArray%(offset% + j%)
NEXT j%
DEF SEG
NEXT y%
FOR x% = 25 TO 1 STEP -1
' The hori(zontal portion...
offset% = (x% - 1) * 160
DEF SEG = vidSeg
FOR i% = offset% TO offset% + (x% * 6)
POKE i%, sArray%(i%)
NEXT i%
' ...and the vertical portion.
FOR y% = 1 TO x%
offset% = ((y% - 1) * 160) + (x% * 6)
DEF SEG = vidSeg
FOR j% = 0 TO 5
POKE offset% + j%, sArray%(offset% + j%)
NEXT j%
DEF SEG
NEXT y%
NEXT x%
CASE 15 ' ─ Random blocks ───────────────────────────────────────────────
RANDOMIZE TIMER
DIM screenGrid%(1 TO 5, 1 TO 10)
FOR x% = 1 TO 50
' Find a block of the screen that hasn't been displayed yet
validBlock% = FALSE
DO
row% = INT(RND(1) * 5) + 1
col% = INT(RND(1) * 10) + 1
IF screenGrid%(row%, col%) = FALSE THEN
validBlock% = TRUE
screenGrid%(row%, col%) = TRUE
END IF
LOOP UNTIL validBlock%
' Display the block
FOR i% = ((row% - 1) * 5) TO ((row% - 1) * 5) + 4
offset% = (i% * 160) + ((col% - 1) * 16)
DEF SEG = vidSeg
FOR j% = offset% TO offset% + 15
POKE j%, sArray%(j%)
NEXT j%
DEF SEG
NEXT i%
NEXT x%
END SELECT
END SUB
SUB Center (st$, row%)
'┌────────────────────────────────────────────────────────────────────────┐
'│ This subroutine will display a string passed to it centered on the │
'│ row passed to it. Parameters are as follows: │
'│ │
'│ st$ - The string to center on the screen. String must be 80 │
'│ characters or less. │
'│ row% - The row of the screen on which to center the string. │
'│ Must be in the range 1 through 25. │
'└────────────────────────────────────────────────────────────────────────┘
'──────────────────────────────────────────────────────────────────────────
' Calculate X-Coordinate (column) on which to locate the string
'──────────────────────────────────────────────────────────────────────────
x% = INT((80 - (LEN(st$))) / 2) + 1
'──────────────────────────────────────────────────────────────────────────
' Display the text string
'──────────────────────────────────────────────────────────────────────────
LOCATE row%, x%, 0: PRINT st$;
END SUB
SUB ClrScr (mode%, fillChar$)
'┌────────────────────────────────────────────────────────────────────────┐
'│ This routine clears the screen in any of 10 different ways. The │
'│ parameters are as follows: │
'│ │
'│ mode% - A number indicating which way you want the screen cleared. │
'│ The number must be in the range of 0 through 14. See the │
'│ QBSCR documentation or the REF program for more info. │
'│ fillChar$ - This is a single character string containing the │
'│ character you want to clear the screen with. Under │
'│ most circumstances, this will simply be a space. │
'└────────────────────────────────────────────────────────────────────────┘
'──────────────────────────────────────────────────────────────────────────
' The Delay local variable is used here for dummy loops that create a
' very brief pauses of execution at points in the routine that need it,
' particularly in the vertical motion. Change this value to suit the
' speed of your machine.
'──────────────────────────────────────────────────────────────────────────
delay = 5
'──────────────────────────────────────────────────────────────────────────
' Clear the screen. Method used is based on the passed Mode parameter
'──────────────────────────────────────────────────────────────────────────
SELECT CASE mode%
CASE 0 ' ─ Horizontal clear, middle out ────────────────────────────
y = 12
FOR x = 13 TO 1 STEP -1
FOR a = 1 TO delay: NEXT a
y = y + 1
LOCATE x, 1, 0: PRINT STRING$(80, fillChar$);
LOCATE y, 1, 0: PRINT STRING$(80, fillChar$);
NEXT x
CASE 1 ' ─ Horizontal clear, ends in ───────────────────────────────
y = 26
FOR x = 1 TO 13
FOR a = 1 TO delay: NEXT a
y = y - 1
LOCATE x, 1, 0: PRINT STRING$(80, fillChar$);
LOCATE y, 1, 0: PRINT STRING$(80, fillChar$);
NEXT x
CASE 2 ' ─ Vertical clear, middle out ───────────────────────────────
y% = 39
FOR x% = 39 TO 1 STEP -2
y% = y% + 2
FOR a% = 1 TO 25
LOCATE a%, x%, 0: PRINT fillChar$ + fillChar$;
LOCATE a%, y%, 0: PRINT fillChar$ + fillChar$;
NEXT a%
NEXT x%
CASE 3 ' ─ Vertical clear, ends in ──────────────────────────────────
y% = 81
FOR x% = 1 TO 40 STEP 2
y% = y% - 2
FOR a% = 1 TO 25
LOCATE a%, x%, 0: PRINT fillChar$ + fillChar$;
LOCATE a%, y%, 0: PRINT fillChar$ + fillChar$;
NEXT a%
NEXT x%
CASE 4 ' ─ Left to right screen wipe ────────────────────────────────
FOR x% = 1 TO 79 STEP 2
FOR a% = 1 TO 25
LOCATE a%, x%, 0: PRINT fillChar$ + fillChar$;
NEXT a%
NEXT x%
CASE 5 ' ─ Right to left screen wipe ────────────────────────────────
FOR x% = 79 TO 1 STEP -2
FOR a% = 1 TO 25
LOCATE a%, x%, 0: PRINT fillChar$ + fillChar$;
NEXT a%
NEXT x%
CASE 6 ' ─ All sides in to center ───────────────────────────────────
y% = 26
FOR x% = 1 TO 13
y% = y% - 1
LOCATE x%, 1, 0: PRINT STRING$(80, fillChar$);
LOCATE y%, 1, 0: PRINT STRING$(80, fillChar$);
FOR a1% = 1 TO 25
LOCATE a1%, x% * 3 - 2, 0: PRINT fillChar$ + fillChar$ + fillChar$;
LOCATE a1%, y% * 3 + 3, 0: PRINT fillChar$ + fillChar$ + fillChar$;
NEXT a1%
NEXT x%
CASE 7 ' ─ All sides out from center ────────────────────────────────
y% = 12
FOR x% = 13 TO 1 STEP -1
y% = y% + 1
LOCATE x%, x% * 3 + 1, 0: PRINT STRING$((y% * 3 - x% * 3) + 2, fillChar$);
LOCATE y%, x% * 3 + 1, 0: PRINT STRING$((y% * 3 - x% * 3) + 2, fillChar$);
FOR a1% = x% TO y%
LOCATE a1%, x% * 3 - 2, 0: PRINT fillChar$ + fillChar$ + fillChar$;
LOCATE a1%, y% * 3 + 3, 0: PRINT fillChar$ + fillChar$ + fillChar$;
NEXT a1%
NEXT x%
CASE 8 ' ─ Vertical split - left down, right up ─────────────────────
y = 26
FOR x = 1 TO 25
FOR a = 1 TO delay: NEXT a
y = y - 1
LOCATE x, 1, 0: PRINT STRING$(40, fillChar$);
LOCATE y, 41, 0: PRINT STRING$(40, fillChar$);
NEXT x
CASE 9 ' ─ Horizontal split - top right to left, bottom left to right
y% = 81
FOR x% = 1 TO 80 STEP 2
y% = y% - 2
FOR a% = 1 TO 12
LOCATE a%, x%, 0: PRINT fillChar$ + fillChar$;
NEXT a%
FOR a% = 13 TO 25
LOCATE a%, y%, 0: PRINT fillChar$ + fillChar$;
NEXT a%
NEXT x%
CASE 10 ' ─ Spiral inward ────────────────────────────────────────────
FOR x = 1 TO 25
FOR y = 1 TO delay: NEXT y
LOCATE x, 1, 0: PRINT STRING$(16, fillChar$);
NEXT x
FOR x% = 16 TO 78 STEP 3
FOR y% = 20 TO 25
LOCATE y%, x%, 0: PRINT STRING$(5, fillChar$);
NEXT y%
NEXT x%
FOR x = 19 TO 1 STEP -1
FOR y = 1 TO delay: NEXT y
LOCATE x, 65, 0: PRINT STRING$(16, fillChar$);
NEXT x
FOR x% = 65 TO 16 STEP -3
FOR y% = 1 TO 6
LOCATE y%, x%, 0: PRINT STRING$(5, fillChar$);
NEXT y%
NEXT x%
FOR x = 7 TO 19
FOR y = 1 TO delay: NEXT y
LOCATE x, 17, 0: PRINT STRING$(16, fillChar$);
NEXT x
FOR x% = 32 TO 64 STEP 3
FOR y% = 15 TO 19
LOCATE y%, x%, 0: PRINT STRING$(5, fillChar$);
NEXT y%
NEXT x%
FOR x = 14 TO 6 STEP -1
FOR y = 1 TO delay: NEXT y
LOCATE x, 49, 0: PRINT STRING$(16, fillChar$);
NEXT x
FOR x% = 48 TO 33 STEP -3
FOR y% = 7 TO 10
LOCATE y%, x%, 0: PRINT STRING$(5, fillChar$);
NEXT y%
NEXT x%
FOR x = 11 TO 14
FOR y = 1 TO delay: NEXT y
LOCATE x, 33, 0: PRINT STRING$(16, fillChar$);
NEXT x
CASE 11 ' ─ Top to bottom ────────────────────────────────────────────
FOR x = 1 TO 25
FOR a = 1 TO delay: NEXT a
LOCATE x, 1, 0: PRINT STRING$(80, fillChar$);
NEXT x
CASE 12 ' ─ Bottom to top ────────────────────────────────────────────
FOR x = 25 TO 1 STEP -1
FOR a = 1 TO delay: NEXT a
LOCATE x, 1, 0: PRINT STRING$(80, fillChar$);
NEXT x
CASE 13 ' ─ Upper-left corner to lower-right ─────────────────────────
fill$ = ""
FOR x% = 1 TO 25
fill$ = fill$ + STRING$(3, fillChar$)
LOCATE x%, 1, 0
PRINT fill$;
FOR y% = 1 TO x%
LOCATE y%, x% * 3, 0
PRINT STRING$(3, fillChar$);
NEXT y%
NEXT x%
FOR y% = 1 TO 25
LOCATE y%, 78, 0
PRINT STRING$(3, fillChar$);
NEXT y%
CASE 14 ' ─ Lower-right corner to upper-left ─────────────────────────
FOR y% = 1 TO 25
LOCATE y%, 78, 0
PRINT STRING$(3, fillChar$);
NEXT y%
fill$ = STRING$(80, fillChar$)
FOR x% = 25 TO 1 STEP -1
fill$ = LEFT$(fill$, LEN(fill$) - 3)
LOCATE x%, 1, 0
PRINT fill$;
FOR y% = 1 TO x%
LOCATE y%, x% * 3, 0
PRINT STRING$(3, fillChar$);
NEXT y%
NEXT x%
CASE 15 ' ─ Random blocks ────────────────────────────────────────────
RANDOMIZE TIMER
DIM screenGrid%(1 TO 5, 1 TO 10)
' Initialize grid tracking array to all false
FOR row% = 1 TO 5
FOR col% = 1 TO 10
screenGrid%(row%, col%) = FALSE
NEXT col%
NEXT row%
FOR x% = 1 TO 50
' Find a block of the scren that hasn't been blanked yet
validBlock% = FALSE
DO
row% = INT(RND(1) * 5) + 1
col% = INT(RND(1) * 10) + 1
IF screenGrid%(row%, col%) = FALSE THEN
validBlock% = TRUE
screenGrid%(row%, col%) = TRUE
END IF
LOOP UNTIL validBlock%
' Blank out the block
FOR i% = ((row% * 5 + 1) - 5) TO ((row% * 5 + 1) - 5) + 4
LOCATE i%, (col% * 8 + 1) - 8, 0
PRINT STRING$(8, fillChar$);
NEXT i%
NEXT x%
CASE ELSE ' Programmer passed an invalide Mode% - do nothing
END SELECT
LOCATE 1, 1, 0
END SUB
FUNCTION ColorChk
'┌────────────────────────────────────────────────────────────────────────┐
'│ This function when called checks the value stored at the machine │
'│ memory location that contains the video display type. If the value │
'│ is hex B4 then the display is mono. Otherwise, it is color. The │
'│ function returns a value of False (Zero) if mono, True (Non-Zero) if │
'│ color. │
'└────────────────────────────────────────────────────────────────────────┘
'──────────────────────────────────────────────────────────────────────────
' Set default segment to 0
'──────────────────────────────────────────────────────────────────────────
DEF SEG = 0
'──────────────────────────────────────────────────────────────────────────
' PEEK at value stored at video adapter address
'──────────────────────────────────────────────────────────────────────────
adapter = PEEK(&H463)
'──────────────────────────────────────────────────────────────────────────
' Set ColorChk to True or False based on value at hex &H463
'──────────────────────────────────────────────────────────────────────────
IF adapter = &HB4 THEN
ColorChk = 0 ' Mono (False/Zero)
ELSE
ColorChk = 1 ' Color (True/Non-Zero)
END IF
END FUNCTION
SUB DisplayEntry (entry$, qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, actionCode%)
'┌─────────────────────────────────────────────────────────────────────────┐
'│ This routine is used only by the MakeMenu% Function. It is not meant │
'│ for use on its own. The routine displays the passed menu entry on the │
'│ screen, and highlights the character that proceeds the marker │
'│ character. │
'│ │
'│ Parameters are as follows: │
'│ │
'│ entry$ - the actual text entry to display on the screen │
'│ qfg% - Foreground color for "Quick Access" key character │
'│ qbg% - Background color for "Quick Access" key character │
'│ hfg% - Foreground color for entry at highlight bar │
'│ hbg% - Background color for entry at highlight bar │
'│ fg% - Foreground color for normal entry │
'│ bg% - Background color for normal entry │
'│ marker$ - the character used in menu entry strings that indicates │
'│ the next character is a "Quick Access" key. │
'│ actionCode% - Has value of 1 or 2. 1 indicates that the entry │
'│ being displayed is a normal, unhighlighted entry, │
'│ thus the "Quick Access" character in the entry will │
'│ be highlighted. If 2, "Quick Access key is not │
'│ highlighted, since entry is in highlight bar. │
'└─────────────────────────────────────────────────────────────────────────┘
'───────────────────────────────────────────────────────────────────────────
' Assumes cursor is already at the right spot to display entry on.
' Display each character until the marker char is found. Print highlighted
' "Quick Access" char if ActionCode% is 1, otherwise print normal "Quick
' Access" char. Then print rest of entry and return to MakeMenu%.
'───────────────────────────────────────────────────────────────────────────
FOR x% = 1 TO LEN(entry$)
IF MID$(entry$, x%, 1) = marker$ THEN
x% = x% + 1
SELECT CASE actionCode%
CASE 1
COLOR qfg%, qbg%
CASE 2
COLOR hfg%, hbg%
CASE ELSE
END SELECT
END IF
PRINT MID$(entry$, x%, 1);
IF actionCode% = 2 THEN
COLOR hfg%, hbg%
ELSE
COLOR fg%, bg%
END IF
NEXT x%
END SUB
FUNCTION GetBackground% (row%, col%)
'┌──────────────────────────────────────────────────────────────────┐
'│ This function will return the background color of the character │
'│ cell at the specified row and column of the screen. │
'└──────────────────────────────────────────────────────────────────┘
'────────────────────────────────────────────────────────────────────
' Set the memory segment to the address of screen memory
'────────────────────────────────────────────────────────────────────
DEF SEG = GetVideoSegment
'────────────────────────────────────────────────────────────────────
' Determine the background color of the cel at row%, col%
'────────────────────────────────────────────────────────────────────
step1% = (PEEK(((row% - 1) * 160) + ((col% - 1) * 2) + 1) AND &HFF) \ 16
IF step1% > 7 THEN ' Foreground is blinking
GetBackground% = step1% - 8
ELSE ' Foreground is NOT blinking
GetBackground% = step1%
END IF
'────────────────────────────────────────────────────────────────────
' Restore BASIC's default data segment
'────────────────────────────────────────────────────────────────────
DEF SEG
END FUNCTION
FUNCTION GetForeground% (row%, col%)
'┌──────────────────────────────────────────────────────────────────┐
'│ This function will return the foreground color of the character │
'│ cell at the specified row and column of the screen. │
'└──────────────────────────────────────────────────────────────────┘
'────────────────────────────────────────────────────────────────────
' Set the memory segment to the address of screen memory
'────────────────────────────────────────────────────────────────────
DEF SEG = GetVideoSegment
'────────────────────────────────────────────────────────────────────
' Determine the foreground color of the cell at row%, col%
'────────────────────────────────────────────────────────────────────
step1% = (PEEK(((row% - 1) * 160) + ((col% - 1) * 2) + 1) AND &HFF)
IF step1% > 127 THEN ' Color is blinking
GetForeground% = ((step1% - 128) MOD 16) + 16
ELSE ' Color is NOT blinking
GetForeground% = step1% MOD 16
END IF
'────────────────────────────────────────────────────────────────────
' Restore BASIC's default data segment
'────────────────────────────────────────────────────────────────────
DEF SEG
END FUNCTION
SUB GetScreen (file$)
'┌──────────────────────────────────────────────────────────────────┐
'│ This subprogram will copy the contents of the display to a disk │
'│ file specified by the file$ parameter. The save is very fast. │
'└──────────────────────────────────────────────────────────────────┘
'────────────────────────────────────────────────────────────────────
' Set the memory segment to the address of screen memory
'────────────────────────────────────────────────────────────────────
DEF SEG = GetVideoSegment
'────────────────────────────────────────────────────────────────────
' Use the BASIC BSAVE statement to save the 4000 bytes of video RAM
'────────────────────────────────────────────────────────────────────
BSAVE file$, 0, 4000
'────────────────────────────────────────────────────────────────────
' Restore BASIC's default data segment
'────────────────────────────────────────────────────────────────────
DEF SEG
END SUB
FUNCTION GetString$ (leftCol, row%, strLen%, foreColor%, backColor%)
'┌────────────────────────────────────────────────────────────────────────┐
'│ This function returns a user-entered string. You can limit the │
'│ length of the string they enter as they type, a capability not │
'│ possible with the INPUT statement. With minor modification of the │
'│ SELECT CASE statements, you can also allow only certain characters │
'│ to be entered. Parameters are as follows: │
'│ │
'│ leftCol - This is the column of the screen to allow the user to │
'│ start typing on. Valid range is 1 through 79. │
'│ row% - This is the row of the screen on which the user will type │
'│ Allowable range is 1 through 25. │
'│ strLen% - This is a number indicating the maximum length of the │
'│ string the user is allowed to enter. Allowable range │
'│ is 1 through 80. │
'│ foreColor% - The foreground color to display the user's entry │
'│ in. Alowable range is 0 through 15. │
'│ backColor% - The background color to display the user's entry │
'│ in. Allowable range is 0 through 7. │
'└────────────────────────────────────────────────────────────────────────┘
'─────────────────────────────────────────────────────────────────────────
' Define variables to contain keycodes
'─────────────────────────────────────────────────────────────────────────
enter$ = CHR$(13)
esc$ = CHR$(27)
backSpace$ = CHR$(8)
'─────────────────────────────────────────────────────────────────────────
' Define errortone string to use with PLAY
'─────────────────────────────────────────────────────────────────────────
errorTone$ = "L60 N1 N0 N1"
'─────────────────────────────────────────────────────────────────────────
' Clear variable that holds keystroke
'─────────────────────────────────────────────────────────────────────────
key$ = ""
'─────────────────────────────────────────────────────────────────────────
' Set count of user-entered characters to 0
'─────────────────────────────────────────────────────────────────────────
charCount% = 0
'─────────────────────────────────────────────────────────────────────────
' Set colors and locate the cursor
'─────────────────────────────────────────────────────────────────────────
COLOR foreColor%, backColor%
LOCATE row%, leftCol, 1
'─────────────────────────────────────────────────────────────────────────
' Display an empty entry field and restore cursor location
'─────────────────────────────────────────────────────────────────────────
PRINT SPACE$(strLen%);
LOCATE row%, leftCol, 1
'─────────────────────────────────────────────────────────────────────────
' Read keystrokes until ENTER is pressed, signalling completion.
'─────────────────────────────────────────────────────────────────────────
WHILE key$ <> enter$
key$ = ""
WHILE key$ = ""
key$ = INKEY$
WEND
'─────────────────────────────────────────────────────────────────────
'== Decide what to do with the returned key
'─────────────────────────────────────────────────────────────────────
SELECT CASE key$
'─────────────────────────────────────────────────────────────────
' The CASE statement below is what checks for allowable characters.
' If you wish to change the set of allowable characters, change the
' conditions of the CASE statement.
'─────────────────────────────────────────────────────────────────
CASE " " TO "■" ' ASCII 32 to 254 - allowable characters
'─────────────────────────────────────────────────────────────
' If user has not reached the assigned maximum string length,
' then add the new keystroke to the entry. Otherwise, make
' an error tone.
'─────────────────────────────────────────────────────────────
IF charCount% < strLen% THEN
st$ = st$ + key$
charCount% = charCount% + 1
LOCATE row%, leftCol + charCount% - 1, 1
PRINT key$;
LOCATE row%, leftCol + charCount%, 1
ELSE
PLAY errorTone$
END IF
CASE backSpace$
'─────────────────────────────────────────────────────────────
' Allow corrections via the backspace key as long as the user
' has not backspaced to the beginning of the line. If they
' have, then play the error tone.
'─────────────────────────────────────────────────────────────
IF charCount% > 0 THEN
st$ = LEFT$(st$, LEN(st$) - 1)
LOCATE row%, leftCol + charCount% - 1, 1
PRINT " ";
charCount% = charCount% - 1
LOCATE row%, leftCol + charCount%, 1
ELSE
PLAY errorTone$
END IF
CASE enter$
'─────────────────────────────────────────────────────────────
' Finished entering string - assign string to function
'─────────────────────────────────────────────────────────────
GetString$ = st$
CASE esc$
'─────────────────────────────────────────────────────────────
' User hit ESCape - abort entry - exit function
'─────────────────────────────────────────────────────────────
GetString$ = esc$
EXIT FUNCTION
CASE ELSE
'─────────────────────────────────────────────────────────────
' Unacceptable key was hit
'─────────────────────────────────────────────────────────────
PLAY errorTone$
END SELECT ' CASE Key$
WEND ' WHILE Key$ <> Enter$
END FUNCTION
FUNCTION GetVideoSegment
'┌──────────────────────────────────────────────────────────────────────────┐
'│ This function returns as a value the memory address where the video │
'│ display memory begins. There are only two possible return values, one │
'│ for monochrome and one for color. This routine is used to obtain the │
'│ video segment for use with the QBSCR routines ScrnSave and ScrnRestore. │
'│ Call this routine, obtain the segment, and then pass it to the two │
'│ above listed routines. │
'└──────────────────────────────────────────────────────────────────────────┘
'──────────────────────────────────────────────────────────────────────────
' Set default segment to 0.
'──────────────────────────────────────────────────────────────────────────
DEF SEG = 0
'──────────────────────────────────────────────────────────────────────────
' PEEK at value stored at video adapter address.
'──────────────────────────────────────────────────────────────────────────
adapter = PEEK(&H463)
'──────────────────────────────────────────────────────────────────────────
' Set function equal to proper segment value.
'──────────────────────────────────────────────────────────────────────────
IF adapter = &HB4 THEN
GetVideoSegment = &HB000 ' Mono
ELSE
GetVideoSegment = &HB800 ' Color
END IF
END FUNCTION
FUNCTION MakeMenu% (choice$(), numOfChoices%, justify$, leftColumn, rightColumn, row%, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%)
'┌────────────────────────────────────────────────────────────────────────┐
'│ The MakeMenu function displays a menu list on the screen and allows │
'│ the user to move a scrolling selection bar to highlight the entry of │
'│ their choice. Selection is made by hitting the ENTER key. Other │
'│ allowable keys include Home or PgUp to move to the first menu entry, │
'│ and End or PgDn to move to the last entry. Scroll bar wraps from top │
'│ to bottom and bottom to top. The function returns as a value the │
'│ position of the entry in the list of the user's selection. For ex- │
'│ ample, if the user selected the third item in a list of eight, the │
'│ function would return a value of three. Parameters for this function │
'│ are: │
'│ │
'│ choice$() - An array of strings that contains the actual menu │
'│ entries. Example: Choice$(1) = "Menu selcection 1". │
'│ Strings must be 78 characters or less in length. │
'│ numOfChoices% - The number of menu choices available. The same as │
'│ the number of elements in Choices$(). Allowable │
'│ range is 1 through 25. │
'│ justify$ - This string will contain a single letter, either an L, C, │
'│ or a R. L means left-justify the menu entries. C means │
'│ center them with respect to the left and right sides of │
'│ the menu (see LeftColumn and RightColumn parameters below) │
'│ and an R means right-justify the menu entries. │
'│ leftColumn - A numerical value containing the left-most column on │
'│ which menu entries will be displayed. Allowable range │
'│ is 1 though 76. │
'│ rightColumn - A numerical value containing the right-most column on │
'│ which menu entries will be displayed. Allowable range │
'│ is 5 through 80. │
'│ row% - A numerical value containing the first row on which to display │
'│ menu entries. Allowable range is 1 through 24. │
'│ marker$ - The character used in the menu entry strings that indicates │
'│ the next character is a "Quick Access" key.
'│ fg% - The foreground color of normal menu entries. Allowable range │
'│ is 0 to 15. │
'│ bg% - The background color of normal menu entries. Allowable range │
'│ is 0 to 7. │
'│ hfg% - The foreground color of the highlighted menu entry. Allowable │
'│ range is 0 to 15. │
'│ hbg% - The background color of the highlighted menu entry. Allowable │
'│ range is 0 to 7. │
'│ qfg% - The foreground color of the Quick Access keys. Allowable │
'│ range is 0 to 15. │
'│ qbg% - The background color of the Quick Access keys. Allowable │
'│ range is 0 to 7. │
'└────────────────────────────────────────────────────────────────────────┘
'─────────────────────────────────────────────────────────────────────────
' Set local variables - extended scan codes for keypad keys
'─────────────────────────────────────────────────────────────────────────
up$ = CHR$(0) + CHR$(72)
down$ = CHR$(0) + CHR$(80)
enter$ = CHR$(13)
home$ = CHR$(0) + CHR$(71)
end$ = CHR$(0) + CHR$(79)
pgUp$ = CHR$(0) + CHR$(73)
pgDn$ = CHR$(0) + CHR$(81)
esc$ = CHR$(27)
'─────────────────────────────────────────────────────────────────────────
' Define the error tone string to use with PLAY
'─────────────────────────────────────────────────────────────────────────
errorTone$ = "MB T120 L50 O3 AF"
'─────────────────────────────────────────────────────────────────────────
' Set type of justification to uppercase
'─────────────────────────────────────────────────────────────────────────
justify$ = UCASE$(justify$)
wdth% = (rightColumn - leftColumn - 1)
'─────────────────────────────────────────────────────────────────────────
' Check for out-of-bounds parameters. If any are out of range,
' quit the function
'─────────────────────────────────────────────────────────────────────────
IF numOfChoices% < 2 OR numOfChoices% > 25 THEN EXIT FUNCTION
IF justify$ <> "C" AND justify$ <> "L" AND justify$ <> "R" THEN EXIT FUNCTION
IF leftColumn < 1 OR rightColumn > 80 THEN EXIT FUNCTION
IF row% < 1 OR row% > 24 THEN EXIT FUNCTION
'─────────────────────────────────────────────────────────────────────────
' Calculate the array of character identifiers
'─────────────────────────────────────────────────────────────────────────
REDIM charID(numOfChoices%) AS STRING * 1
FOR x% = 1 TO numOfChoices%
FOR y% = 1 TO LEN(choice$(x%))
IF MID$(choice$(x%), y%, 1) = marker$ THEN
charID(x%) = UCASE$(MID$(choice$(x%), y% + 1, 1))
EXIT FOR
END IF
NEXT y%
NEXT x%
'─────────────────────────────────────────────────────────────────────────
' Calculate length of longest menu choice and store value in ChoiceLen%
'─────────────────────────────────────────────────────────────────────────
choiceLen% = 0
FOR x% = 1 TO numOfChoices%
IF LEN(choice$(x%)) > choiceLen% THEN
choiceLen% = LEN(choice$(x%))
END IF
NEXT x%
choiceLen% = choiceLen% - 1
'─────────────────────────────────────────────────────────────────────────
' Determine left-most column to display highlight bar on
'─────────────────────────────────────────────────────────────────────────
col = (((rightColumn - leftColumn - 1) - choiceLen%) / 2) + leftColumn
'─────────────────────────────────────────────────────────────────────────
' Print menu choices to screen based on the type of Justification
' selected (Center, Left, Right).
'─────────────────────────────────────────────────────────────────────────
COLOR fg%, bg%
SELECT CASE justify$
CASE "C"
FOR x% = 1 TO numOfChoices%
xCol% = ((wdth% - (LEN(choice$(x%))) - 1) \ 2 + leftColumn) + 1
LOCATE (row% - 1) + x%, leftColumn - 1, 0
PRINT SPACE$(choiceLen% + 2);
LOCATE (row% - 1) + x%, xCol%, 0
DisplayEntry choice$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
NEXT x%
CASE "R"
FOR x% = 1 TO numOfChoices%
LOCATE (row% - 1) + x%, leftColumn - 1, 0
PRINT SPACE$(choiceLen% + 2);
LOCATE (row% - 1) + x%, (rightColumn - LEN(choice$(x%)))
DisplayEntry choice$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
NEXT x%
CASE "L"
FOR x% = 1 TO numOfChoices%
LOCATE (row% - 1) + x%, leftColumn - 1, 0
PRINT SPACE$(choiceLen% + 2);
LOCATE (row% - 1) + x%, leftColumn, 0
DisplayEntry choice$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
NEXT x%
END SELECT
'─────────────────────────────────────────────────────────────────────────
' Highlight the first entry in the list. Must take into account the
' justification type.
'─────────────────────────────────────────────────────────────────────────
currentLocation% = 1
COLOR hfg%, hbg%
LOCATE row%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
SELECT CASE justify$
CASE "C"
xCol% = ((wdth% - (LEN(choice$(currentLocation%))) - 1) \ 2 + leftColumn) + 1
LOCATE (row% - 1 + currentLocation%), xCol%, 0
DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
CASE "R"
LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%)))
DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
CASE "L"
LOCATE (row% - 1) + currentLocation%, leftColumn
DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
END SELECT
'─────────────────────────────────────────────────────────────────────────
' Read keystrokes and change the highlighted entry appropriately
'─────────────────────────────────────────────────────────────────────────
exitCode = FALSE
WHILE exitCode = FALSE
'─────────────────────────────────────────────────────────────────────
' Read keystrokes
'─────────────────────────────────────────────────────────────────────
key$ = ""
WHILE key$ = ""
LET key$ = UCASE$(INKEY$)
WEND
SELECT CASE key$
CASE up$, down$, home$, end$, pgUp$, pgDn$ '=== Legal movement
'─────────────────────────────────────────────────────────────
' Restore old highlighted choice to normal colors
'─────────────────────────────────────────────────────────────
COLOR fg%, bg%
LOCATE (row% - 1) + currentLocation%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
SELECT CASE justify$
CASE "C"
xCol% = ((wdth% - (LEN(choice$(currentLocation%))) - 1) \ 2 + leftColumn) + 1
LOCATE (row% - 1 + currentLocation%), xCol%, 0
DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
CASE "R"
LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%)))
DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
CASE "L"
LOCATE (row% - 1) + currentLocation%, leftColumn, 0
DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
END SELECT
CASE CHR$(32) TO CHR$(127) 'If valid KEY code, then restore old entry
FOR x% = 1 TO numOfChoices%
IF key$ = charID(x%) THEN
COLOR fg%, bg%
LOCATE (row% - 1) + currentLocation%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
SELECT CASE justify$
CASE "C"
xCol% = ((wdth% - (LEN(choice$(currentLocation%))) - 1) \ 2 + leftColumn) + 1
LOCATE (row% - 1 + currentLocation%), xCol%, 0
DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
EXIT FOR
CASE "R"
LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%)))
DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
EXIT FOR
CASE "L"
LOCATE (row% - 1) + currentLocation%, leftColumn, 0
DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
EXIT FOR
END SELECT
END IF
NEXT x%
CASE ELSE
'Nuthin!
END SELECT
'─────────────────────────────────────────────────────────────────────
' Update our highlight bar's location based on which key was hit
'─────────────────────────────────────────────────────────────────────
SELECT CASE key$
CASE up$
'─────────────────────────────────────────────────────────────
' Set new currentLocation%
'─────────────────────────────────────────────────────────────
IF currentLocation% = 1 THEN
currentLocation% = numOfChoices%
ELSE
currentLocation% = currentLocation% - 1
END IF
CASE down$
'─────────────────────────────────────────────────────────────
' Set New currentLocation%
'─────────────────────────────────────────────────────────────
IF currentLocation% = numOfChoices% THEN
currentLocation% = 1
ELSE
currentLocation% = currentLocation% + 1
END IF
CASE enter$
'─────────────────────────────────────────────────────────────
' Set MakeMenu to highlighted selection and exit
'─────────────────────────────────────────────────────────────
MakeMenu% = currentLocation%
'─────────────────────────────────────────────────────────────
' Instead of using exitCode to beak out of this, we have to
' use EXIT FUNCTION, or it never quits.
'─────────────────────────────────────────────────────────────
EXIT FUNCTION
CASE home$, pgUp$
'─────────────────────────────────────────────────────────────
' Set New currentLocation%
'─────────────────────────────────────────────────────────────
currentLocation% = 1
CASE end$, pgDn$
'─────────────────────────────────────────────────────────────
' Set New currentLocation%
'─────────────────────────────────────────────────────────────
currentLocation% = numOfChoices%
CASE esc$
'─────────────────────────────────────────────────────────────
' User hit ESCAPE key, so set MakeMenu to 0 nd exit
'─────────────────────────────────────────────────────────────
MakeMenu% = 0
EXIT FUNCTION
CASE CHR$(32) TO CHR$(127)
'─────────────────────────────────────────────────────────────
' Check for "Quick Access" codes
'─────────────────────────────────────────────────────────────
validEntry% = FALSE
FOR x% = 1 TO numOfChoices%
IF key$ = charID(x%) THEN
MakeMenu% = x%
currentLocation% = x%
validEntry% = TRUE
END IF
NEXT x%
IF validEntry% = FALSE THEN
PLAY errorTone$
END IF
CASE ELSE
'─────────────────────────────────────────────────────────────
' Play Error Tone - change this around if your don't like it
'─────────────────────────────────────────────────────────────
PLAY errorTone$
END SELECT
'─────────────────────────────────────────────────────────────────────
' Highlight the entry indicated by CurrentLocation%
'─────────────────────────────────────────────────────────────────────
SELECT CASE key$
CASE up$, down$, home$, end$, pgUp$, pgDn$
'─────────────────────────────────────────────────────────────
' Highlight new choice
'─────────────────────────────────────────────────────────────
COLOR hfg%, hbg%
LOCATE (row% - 1) + currentLocation%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
SELECT CASE justify$
CASE "C"
xCol% = ((wdth% - (LEN(choice$(currentLocation%))) - 1) \ 2 + leftColumn) + 1
LOCATE (row% - 1 + currentLocation%), xCol%, 0
DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
CASE "R"
LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%)))
DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
CASE "L"
LOCATE (row% - 1) + currentLocation%, leftColumn, 0
DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
END SELECT
CASE CHR$(32) TO CHR$(127)
FOR x% = 1 TO numOfChoices%
IF key$ = charID(x%) THEN
'─────────────────────────────────────────────────────
' Highlight new choice
'─────────────────────────────────────────────────────
COLOR hfg%, hbg%
LOCATE (row% - 1) + currentLocation%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
SELECT CASE justify$
CASE "C"
xCol% = ((wdth% - (LEN(choice$(currentLocation%))) - 1) \ 2 + leftColumn) + 1
LOCATE (row% - 1 + currentLocation%), xCol%, 0
DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
EXIT FUNCTION
CASE "R"
LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%)))
DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
EXIT FUNCTION
CASE "L"
LOCATE (row% - 1) + currentLocation%, leftColumn, 0
DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
EXIT FUNCTION
END SELECT
END IF
NEXT x%
CASE ELSE
'Nuthin!
END SELECT
WEND
END FUNCTION
SUB MakeWindow (topRow!, leftCol!, botRow!, rightCol!, foreColor%, backColor%, windowType%, frameType%, shadowColor%, explodeType%, label$)
'┌────────────────────────────────────────────────────────────────────────┐
'│ The MakeWindow subroutine draws windows on the screen for you. The │
'│ kinds of windows you can make is quite varied. There are 10 │
'│ window types, six different frame types, windows can have shadows │
'│ or not, you can "explode" them onto the screen, and even place labels │
'│ on them. The parameters for MakeWindow are as follows: │
'│ │
'│ topRow! - This is a numerical value containing the top-most row of │
'│ the window. Allowable range is 1 through 22. │
'│ leftCol! - This is a numerical value containing the left-most side │
'│ of the window. Allowable range is 1 to 79. │
'│ botRow! - This is a numerical value containing the bottom-most row │
'│ of the window. Allowable range is 2 through 23. │
'│ rightCol! - This is a numerical value containing the right-most row │
'│ of the window. Allowable range is 2 through 80. │
'│ foreColor% - This is the foreground color of the window. Allowable │
'│ range is 0 through 15. │
'│ backColor% - This is the background color of the window. Allowable │
'│ range is 0 through 7. │
'│ windowType% - This is a numerical value containing the type of window │
'│ desired. Allowable range is 0 through 9. See the │
'│ QBSCR documentation for more info. │
'│ frameType% - This is a numerical value containing the type of frame │
'│ you want your window to have. Allowable range is 0 │
'│ through 5. See the QBSCR documentation for more info. │
'│ shadowColor% - This is a numerical value containing the color of the │
'│ shadow for your window. If you desire no shadow at │
'│ all, use a value of -1. Allowable range is -1 through │
'│ 15. See the QBSCR documentation for more detail. │
'│ explodeType% - This is a numerical value that indicates how you want │
'│ your window to be placed on the screen. A value of 0 │
'│ display it normally, top to bottom. A value of 1 │
'│ means explode it onto the screen using auto mode. A │
'│ value of 2 means explode it onto the screen using the │
'│ horizontal bias mode, and a value of 3 means explode │
'│ it onto the screen using the vertical bias mode. See │
'│ the QBSCR documentation for more details. │
'│ label$ - This is a string used to label your window. It is placed │
'│ along the top line of your window, framed by brackets. │
'│ A string of zero length ("") means don't display any label. │
'│ Allowable string length is equal to (RightCol - LeftCol) - 4 │
'└────────────────────────────────────────────────────────────────────────┘
'─────────────────────────────────────────────────────────────────────────
' Setup line$ as a dynamic array that can REDimensioned. Line$()
' will contain the actual character strings that make up our window.
'─────────────────────────────────────────────────────────────────────────
'$DYNAMIC
DIM line$(24)
'─────────────────────────────────────────────────────────────────────────
' Initialize local variables
'─────────────────────────────────────────────────────────────────────────
part1 = 0: part2 = 0: numLines = 0
'─────────────────────────────────────────────────────────────────────────
' Check all passed values for validity and set defaults
'─────────────────────────────────────────────────────────────────────────
numLines = 0
IF topRow < 1 THEN topRow = 1: IF topRow > 22 THEN topRow = 22
IF botRow < 2 THEN botRow = 2: IF botRow > 25 THEN botRow = 25
IF rightCol < 2 THEN rightCol = 2: IF rightCol > 80 THEN rightCol = 80
IF leftCol < 1 THEN leftCol = 1: IF leftCol > 79 THEN leftCol = 79
IF foreColor% < 0 OR foreColor% > 15 THEN foreColor% = 7
IF backColor% < 0 OR backColor% > 7 THEN backColor% = 0
IF windowType% < 0 OR windowType% > 9 THEN windowType% = 0
IF frameType% < 0 OR frameType% > 5 THEN frameType% = 0
IF shadowColor% > 16 THEN shadowColor% = -1
IF explodeType% < 0 OR explodeType% > 3 THEN explodeType% = 0
IF LEN(label$) > ((rightCol - leftCol) - 4) THEN label$ = ""
'─────────────────────────────────────────────────────────────────────────
' Setup graphics characters to use based on FrameType%
'─────────────────────────────────────────────────────────────────────────
SELECT CASE frameType%
CASE 0 ' All lines SINGLE
urc$ = CHR$(191): ulc$ = CHR$(218): llc$ = CHR$(192): lrc$ = CHR$(217)
ver$ = CHR$(179): hor$ = CHR$(196)
vtl$ = CHR$(195): vtr$ = CHR$(180)
htt$ = CHR$(194): htb$ = CHR$(193)
crs$ = CHR$(197): blk$ = CHR$(219)
lbl$ = CHR$(180): lbr$ = CHR$(195)
CASE 1 ' All lines DOUBLE
urc$ = CHR$(187): ulc$ = CHR$(201): llc$ = CHR$(200): lrc$ = CHR$(188)
ver$ = CHR$(186): hor$ = CHR$(205)
vtl$ = CHR$(204): vtr$ = CHR$(185)
htt$ = CHR$(203): htb$ = CHR$(202)
crs$ = CHR$(206): blk$ = CHR$(219)
lbl$ = CHR$(181): lbr$ = CHR$(198)
CASE 2 ' Horizontals SINGLE / Verticals DOUBLE
urc$ = CHR$(183): ulc$ = CHR$(214): llc$ = CHR$(211): lrc$ = CHR$(189)
ver$ = CHR$(186): hor$ = CHR$(196)
vtl$ = CHR$(199): vtr$ = CHR$(182)
htt$ = CHR$(210): htb$ = CHR$(208)
crs$ = CHR$(215): blk$ = CHR$(219)
lbl$ = CHR$(180): lbr$ = CHR$(195)
CASE 3 ' Horizontals DOUBLE / Verticals SINGLE
urc$ = CHR$(184): ulc$ = CHR$(213): llc$ = CHR$(212): lrc$ = CHR$(190)
ver$ = CHR$(179): hor$ = CHR$(205)
vtl$ = CHR$(198): vtr$ = CHR$(181)
htt$ = CHR$(209): htb$ = CHR$(207)
crs$ = CHR$(216): blk$ = CHR$(219)
lbl$ = CHR$(181): lbr$ = CHR$(198)
CASE 4 ' Outside lines DOUBLE / Inside lines SINGLE
urc$ = CHR$(187): ulc$ = CHR$(201): llc$ = CHR$(200): lrc$ = CHR$(188)
ver$ = CHR$(186): ver1$ = CHR$(179): hor$ = CHR$(205): hor1$ = CHR$(196)
vtl$ = CHR$(199): vtr$ = CHR$(182)
htt$ = CHR$(209): htt1$ = CHR$(194): htb$ = CHR$(207): htb1$ = CHR$(193)
crs$ = CHR$(197): blk$ = CHR$(219)
lbl$ = CHR$(181): lbr$ = CHR$(198)
CASE 5 ' Outside lines SINGLE / Inside Lines DOUBLE
urc$ = CHR$(191): ulc$ = CHR$(218): llc$ = CHR$(192): lrc$ = CHR$(217)
ver$ = CHR$(179): ver1$ = CHR$(186): hor$ = CHR$(196): hor1$ = CHR$(205)
vtl$ = CHR$(198): vtr$ = CHR$(181)
htt$ = CHR$(210): htt1$ = CHR$(203): htb$ = CHR$(208): htb1$ = CHR$(202)
crs$ = CHR$(206): blk$ = CHR$(219)
lbl$ = CHR$(180): lbr$ = CHR$(195)
CASE ELSE
' Shouldn't be an "else" !
END SELECT
'─────────────────────────────────────────────────────────────────────────
' Calculate the number of lines to be printed and redimension Lines$()
'─────────────────────────────────────────────────────────────────────────
numLines = (botRow - topRow) + 1
REDIM line$(numLines)
'─────────────────────────────────────────────────────────────────────────
' Determine ExplodeStep% for explode loop based on ExplodeType%
'─────────────────────────────────────────────────────────────────────────
SELECT CASE explodeType%
CASE 0 ' Exploding Windows OFF
explodeStep% = 0
CASE 1 ' Explode automatic - determine explode ratio
explodeStep% = INT((rightCol - leftCol) / (botRow - topRow))
CASE 2 ' Explode ratio biased toward HORIZONTAL
explodeStep% = 3
CASE 3 ' Explode ratio biased toward VERTICAL
explodeStep% = 1
END SELECT
'─────────────────────────────────────────────────────────────────────────
' Construct the window strings based on WindowType%
'─────────────────────────────────────────────────────────────────────────
SELECT CASE windowType%
CASE 0 ' Regular box, no extra lines
line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$
FOR x% = 2 TO numLines - 1
line$(x%) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
NEXT x%
line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$
CASE 1 ' Box with extra internal line at top and bottom
line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$
line$(2) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
IF frameType% = 4 OR frameType% = 5 THEN
tempHOR$ = hor$
hor$ = hor1$
END IF
line$(3) = vtl$ + STRING$((rightCol - leftCol) - 1, hor$) + vtr$
FOR x% = 4 TO numLines - 3
line$(x%) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
NEXT x%
line$(numLines - 2) = vtl$ + STRING$((rightCol - leftCol) - 1, hor$) + vtr$
line$(numLines - 1) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
IF frameType% = 4 OR frameType% = 5 THEN
hor$ = tempHOR$
END IF
line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$
CASE 2 ' Box with extra internal line at top
line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$
line$(2) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
IF frameType% = 4 OR frameType% = 5 THEN
tempHOR$ = hor$
hor$ = hor1$
END IF
line$(3) = vtl$ + STRING$((rightCol - leftCol) - 1, hor$) + vtr$
FOR x% = 4 TO numLines - 1
line$(x%) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
NEXT x%
IF frameType% = 4 OR frameType% = 5 THEN
hor$ = tempHOR$
END IF
line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$
CASE 3 ' Box with extra internal line at bottom
line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$
FOR x% = 2 TO numLines - 3
line$(x%) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
NEXT x%
IF frameType% = 4 OR frameType% = 5 THEN
tempHOR$ = hor$
hor$ = hor1$
END IF
line$(numLines - 2) = vtl$ + STRING$((rightCol - leftCol) - 1, hor$) + vtr$
line$(numLines - 1) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
IF frameType% = 4 OR frameType% = 5 THEN
hor$ = tempHOR$
END IF
line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$
CASE 4 ' Box with vertical line down the center
part1 = ((rightCol - leftCol) - 1) / 2
IF INT(part1) = part1 THEN
part2 = part1 - 1
ELSE
part1 = INT(part1)
part2 = part1
END IF
line$(1) = ulc$ + STRING$(part1, hor$) + htt$ + STRING$(part2, hor$) + urc$
IF frameType% <> 4 AND frameType% <> 5 THEN
ver1$ = ver$
END IF
FOR x% = 2 TO numLines - 1
line$(x%) = ver$ + SPACE$(part1) + ver1$ + SPACE$(part2) + ver$
NEXT x%
line$(numLines) = llc$ + STRING$(part1, hor$) + htb$ + STRING$(part2, hor$) + lrc$
CASE 5 ' Box with horizontal line down the center
TopHalf = INT(numLines / 2)
line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$
FOR x% = 2 TO TopHalf
line$(x%) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
NEXT x%
IF frameType% = 4 OR frameType% = 5 THEN
tempHOR$ = hor$
hor$ = hor1$
END IF
line$(TopHalf + 1) = vtl$ + STRING$((rightCol - leftCol) - 1, hor$) + vtr$
IF frameType% = 4 OR frameType% = 5 THEN
hor$ = tempHOR$
END IF
FOR x% = TopHalf + 2 TO numLines - 1
line$(x%) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
NEXT x%
line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$
CASE 6 ' Box cross-divided into four sections
TopHalf = INT(numLines / 2): part1 = ((rightCol - leftCol) - 1) / 2
IF INT(part1) = part1 THEN
part2 = part1 - 1
ELSE
part1 = INT(part1): part2 = part1
END IF
line$(1) = ulc$ + STRING$(part1, hor$) + htt$ + STRING$(part2, hor$) + urc$
IF frameType% <> 4 AND frameType% <> 5 THEN ver1$ = ver$
FOR x% = 2 TO TopHalf
line$(x%) = ver$ + SPACE$(part1) + ver1$ + SPACE$(part2) + ver$
NEXT x%
IF frameType% = 4 OR frameType% = 5 THEN
tempHOR$ = hor$: hor$ = hor1$
END IF
line$(TopHalf + 1) = vtl$ + STRING$(part1, hor$) + crs$ + STRING$(part2, hor$) + vtr$
IF frameType% = 4 OR frameType% = 5 THEN hor$ = tempHOR$
FOR x% = TopHalf + 2 TO numLines - 1
line$(x%) = ver$ + SPACE$(part1) + ver1$ + SPACE$(part2) + ver$
NEXT x%
line$(numLines) = llc$ + STRING$(part1, hor$) + htb$ + STRING$(part2, hor$) + lrc$
CASE 7 ' Box with extra internal line at top and vertical
' dividing line for rest of window
part1 = ((rightCol - leftCol) - 1) / 2
IF INT(part1) = part1 THEN
part2 = part1 - 1
ELSE
part1 = INT(part1)
part2 = part1
END IF
line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$
line$(2) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
IF frameType% <> 4 AND frameType% <> 5 THEN
htt1$ = htt$
ver1$ = ver$
hor1$ = hor$
END IF
line$(3) = vtl$ + STRING$(part1, hor1$) + htt1$ + STRING$(part2, hor1$) + vtr$
FOR x% = 4 TO numLines - 1
line$(x%) = ver$ + SPACE$(part1) + ver1$ + SPACE$(part2) + ver$
NEXT x%
line$(numLines) = llc$ + STRING$(part1, hor$) + htb$ + STRING$(part2, hor$) + lrc$
CASE 8 ' Box with extra internalline at bottom and vertical
' dividing line for rest of window
part1 = ((rightCol - leftCol) - 1) / 2
IF INT(part1) = part1 THEN
part2 = part1 - 1
ELSE
part1 = INT(part1)
part2 = part1
END IF
line$(1) = ulc$ + STRING$(part1, hor$) + htt$ + STRING$(part2, hor$) + urc$
IF frameType% <> 4 AND frameType% <> 5 THEN
htb1$ = htb$
ver1$ = ver$
hor1$ = hor$
END IF
FOR x% = 2 TO numLines - 3
line$(x%) = ver$ + SPACE$(part1) + ver1$ + SPACE$(part2) + ver$
NEXT x%
line$(numLines - 2) = vtl$ + STRING$(part1, hor1$) + htb1$ + STRING$(part2, hor1$) + vtr$
line$(numLines - 1) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$
CASE 9 ' Box with extra internal lines at top and bottom,
' with dividing line for rest of window
part1 = ((rightCol - leftCol) - 1) / 2
IF INT(part1) = part1 THEN
part2 = part1 - 1
ELSE
part1 = INT(part1)
part2 = part1
END IF
line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$
line$(2) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
IF frameType% <> 4 AND frameType% <> 5 THEN
htt1$ = htt$
htb1$ = htb$
ver1$ = ver$
hor1$ = hor$
END IF
line$(3) = vtl$ + STRING$(part1, hor1$) + htt1$ + STRING$(part2, hor1$) + vtr$
FOR x% = 4 TO numLines - 3
line$(x%) = ver$ + SPACE$(part1) + ver1$ + SPACE$(part2) + ver$
NEXT x%
line$(numLines - 2) = vtl$ + STRING$(part1, hor1$) + htb1$ + STRING$(part2, hor1$) + vtr$
line$(numLines - 1) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$
CASE ELSE
'─────────────────────────────────────────────────────────────────────
' Shouldn't be an "else" !
'─────────────────────────────────────────────────────────────────────
END SELECT
'─────────────────────────────────────────────────────────────────────────
' Print the Window, Please! Set colors to those passed to MakeWindow
'─────────────────────────────────────────────────────────────────────────
COLOR foreColor%, backColor%
'─────────────────────────────────────────────────────────────────────────
' Print the window on the screen, using method based on ExplodeType%
'─────────────────────────────────────────────────────────────────────────
SELECT CASE explodeType%
CASE 0 ' No explosion - just a straight print. See how easy?
FOR x% = 1 TO numLines
LOCATE (x% + (topRow - 1)), leftCol: PRINT line$(x%);
NEXT x%
CASE 1, 2, 3 ' Explode that window!
expX1% = INT(((rightCol - leftCol) / 2) + leftCol): expX2% = expX1%
expY1% = INT(((botRow - topRow) / 2) + topRow): expY2% = expY1%
WHILE (expX1% > leftCol + 1) OR (expY1% > topRow + 1)
IF expX1% > leftCol THEN expX1% = expX1% - explodeStep%
IF expX2% < rightCol THEN expX2% = expX2% + explodeStep%
IF expY1% > topRow THEN expY1% = expY1% - 1
IF expY2% < botRow THEN expY2% = expY2% + 1
IF expX1% < leftCol THEN expX1% = leftCol: expX2% = rightCol
IF expY1% < topRow THEN expY1% = topRow: expY2% = botRow
LOCATE expY1%, expX1%: PRINT ulc$ + STRING$((expX2% - expX1%) - 1, hor$) + urc$;
FOR x% = expY1% + 1 TO expY2% - 1
LOCATE x%, expX1%: PRINT ver$ + SPACE$((expX2% - expX1%) - 1) + ver$;
NEXT x%
LOCATE expY2%, expX1%: PRINT llc$ + STRING$((expX2% - expX1%) - 1, hor$) + lrc$;
WEND
'─────────────────────────────────────────────────────────────────
' Print a straight window now, after the explosion effect
'─────────────────────────────────────────────────────────────────
FOR x% = 1 TO numLines
LOCATE (x% + (topRow - 1)), leftCol: PRINT line$(x%);
NEXT x%
CASE ELSE
'─────────────────────────────────────────────────────────────────────
' Shouldn't be an "else" !
'─────────────────────────────────────────────────────────────────────
END SELECT
'─────────────────────────────────────────────────────────────────────────
' Add a shadow if required
'─────────────────────────────────────────────────────────────────────────
SELECT CASE shadowColor%
CASE 0 TO 15
'─────────────────────────────────────────────────────────────────────
' Change colors to ShadowColor%
'─────────────────────────────────────────────────────────────────────
COLOR shadowColor%, 0
'─────────────────────────────────────────────────────────────────────
' Define the characters to display for the side/bottom shadow
'─────────────────────────────────────────────────────────────────────
sideShadow$ = STRING$(2, 219)
botShadow$ = STRING$((rightCol - leftCol), 219)
'─────────────────────────────────────────────────────────────────────
' Print the side shadow
'─────────────────────────────────────────────────────────────────────
FOR x% = topRow + 1 TO botRow + 1
LOCATE x%, rightCol + 1: PRINT sideShadow$;
NEXT x%
'─────────────────────────────────────────────────────────────────────
' Print the bottom shadow
'─────────────────────────────────────────────────────────────────────
LOCATE botRow + 1, leftCol + 2: PRINT botShadow$;
CASE 16
'─────────────────────────────────────────────────────────────────────────
' If shadow color is 16 use special shadow
'─────────────────────────────────────────────────────────────────────────
'Side shadow
segment = GetVideoSegment
FOR x% = topRow TO botRow
offset% = (160 * x%) + (rightCol * 2) + 1
DEF SEG = segment
POKE offset%, 7
POKE offset% + 2, 7
DEF SEG
NEXT x%
'Bottom shadow
offset% = (botRow * 160)
FOR x% = ((leftCol + 1) * 2) TO ((rightCol + 1) * 2) STEP 2
DEF SEG = segment
POKE offset% + x% + 1, 7
DEF SEG
NEXT x%
CASE ELSE
END SELECT ' shadowColor%
'─────────────────────────────────────────────────────────────────────────
' Add the Window Label, if possible. Set the colors to those passed
' to MakeWindow routine.
'─────────────────────────────────────────────────────────────────────────
COLOR foreColor%, backColor%
'─────────────────────────────────────────────────────────────────────────
' Add label to window if one was specified
'─────────────────────────────────────────────────────────────────────────
IF label$ <> "" THEN
label$ = lbl$ + label$ + lbr$
LOCATE topRow, leftCol + 1
PRINT label$;
END IF
END SUB
REM $STATIC
SUB MultiMenu (menusArray$(), numEntries%(), menuTitles$(), justify$, marker$, shadowCode%, fg%, bg%, hfg%, hbg%, qfg%, qbg%, menuSelected%, menuEntrySelected%)
'┌──────────────────────────────────────────────────────────────────┐
'│ This routine allows you to create a pull down menu system for │
'│ any program. The parameters are as follows: │
'│ │
'│ menusArray$() - A 2-dimensional array that stores all the │
'│ entries for each menu. The FIRST index │
'│ indicates the particular MENU, while the │
'│ SECOND index indicates the particular entry │
'│ for the menu indicated by the FIRST index. │
'│ numEntries%() - A 1-dimensional array that contains the │
'│ number of actual entries for each menu. │
'│ The index for this array indicates which │
'│ menu you're talking about. │
'│ menuTitles$() - A 1-dimensional array that stores the │
'│ title of each menu. │
'│ justify$ - A single text character indicating the type │
'│ of justification to use when displaying the │
'│ menu will use when displaying the entries │
'│ of each sub-menu. The valid values are: │
'│ "C" - Centered │
'│ "L" - Left justified │
'│ "R" - Right justified │
'│ marker$ - A single character used to identify the │
'│ "Quick Access" key for each menu entry. │
'│ shadowCode% - A value indicating the type of shadowing │
'│ to use for the menu windows. Valid values: │
'│ -1 - No shadow at all │
'│ 0-15 - Shadow of this color │
'│ 16 - Special character shadow │
'│ fg%, bg% - The foreground and background colors of the │
'│ normal, unhighlighted menu entries │
'│ hfg%, hbg% - The foreground and background colors of the │
'│ highlighted menu entries │
'│ qfg%, qbg% - The foreground and background colors of the │
'│ "Quick Access" letters │
'│ menuSelected% - This variable is an "out" parameter. It │
'│ has no value when you call the routine. │
'│ When the MultiMenu returns to the calling │
'│ routine, this variable will contain the │
'│ number of the menu the user made his/her │
'│ selection from. │
'│ menuEntrySelected% - This variable is an "out" parameter. │
'│ It has no value when you call the routine. │
'│ When the MultiMenu returns to the calling │
'│ routine, this variable will contain the │
'│ number of the entry the user selected on │
'│ the menu indicated by menuSelected%. │
'│ │
'│ See the QBSCR Screen Routines documentation for more details. │
'└──────────────────────────────────────────────────────────────────┘
'────────────────────────────────────────────────────────────────────
' Define special keys
'────────────────────────────────────────────────────────────────────
leftArrow$ = CHR$(0) + CHR$(75)
rightArrow$ = CHR$(0) + CHR$(77)
downArrow$ = CHR$(0) + CHR$(80)
homeKey$ = CHR$(0) + CHR$(71)
endKey$ = CHR$(0) + CHR$(79)
enter$ = CHR$(13)
esc$ = CHR$(27)
'────────────────────────────────────────────────────────────────────
' Determine number of menus
'────────────────────────────────────────────────────────────────────
numMenus% = UBOUND(menusArray$, 1)
'────────────────────────────────────────────────────────────────────
' Determine all QuickAccess keys for the menu titles
'────────────────────────────────────────────────────────────────────
DIM charID(1 TO numMenus%) AS STRING * 1
FOR x% = 1 TO numMenus%
FOR y% = 1 TO LEN(menuTitles$(x%))
IF MID$(menuTitles$(x%), y%, 1) = marker$ THEN
charID(x%) = UCASE$(MID$(menuTitles$(x%), y% + 1, 1))
EXIT FOR
END IF
NEXT y%
NEXT x%
'────────────────────────────────────────────────────────────────────
' Display pull-down menus line
'────────────────────────────────────────────────────────────────────
COLOR fg%, bg%
LOCATE 1, 1, 0: PRINT SPACE$(80);
colCount% = 0
FOR x% = 1 TO numMenus%
LOCATE 1, 2 + colCount%, 0: DisplayEntry menuTitles$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
colCount% = colCount% + LEN(menuTitles$(x%)) + 1
NEXT x%
'────────────────────────────────────────────────────────────────────
' Display highlight for first entry
'────────────────────────────────────────────────────────────────────
COLOR hfg%, hbg%
LOCATE 1, 2, 0: DisplayEntry menuTitles$(1), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
'────────────────────────────────────────────────────────────────────
' Wait for keystrokes
'────────────────────────────────────────────────────────────────────
currentMenu% = 1
oldMenu% = 1
done% = FALSE
DO
DO
k$ = UCASE$(INKEY$)
LOOP UNTIL k$ <> ""
SELECT CASE k$
CASE leftArrow$ ' Move highlight to the left
IF currentMenu% > 1 THEN
currentMenu% = currentMenu% - 1
ELSE
currentMenu% = numMenus%
END IF
CASE rightArrow$ ' Move highlight to the right
IF currentMenu% < numMenus% THEN
currentMenu% = currentMenu% + 1
ELSE
currentMenu% = 1
END IF
CASE homeKey$
currentMenu% = 1
CASE endKey$
currentMenu% = numMenus%
CASE enter$, downArrow$ ' Use the current menu and exit DO
done% = TRUE
CASE esc$ ' Abort MultiMenu call
menuSelected% = 0
menuEntrySelected% = 0
EXIT SUB
CASE ELSE
'────────────────────────────────────────────────────────────
' Check for special quick access keys
'────────────────────────────────────────────────────────────
FOR x% = 1 TO numMenus%
IF k$ = charID(x%) THEN
currentMenu% = x%
done% = TRUE
EXIT FOR
END IF
NEXT x%
END SELECT
'────────────────────────────────────────────────────────────────
' Update highlight
'────────────────────────────────────────────────────────────────
colCount% = 0
FOR x% = 1 TO oldMenu% - 1
colCount% = colCount% + LEN(menuTitles$(x%)) + 1
NEXT x%
LOCATE 1, 2 + colCount%, 0: DisplayEntry menuTitles$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
oldMenu% = currentMenu%
colCount% = 0
FOR x% = 1 TO currentMenu% - 1
colCount% = colCount% + LEN(menuTitles$(x%)) + 1
NEXT x%
LOCATE 1, 2 + colCount%, 0: DisplayEntry menuTitles$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
LOOP UNTIL done%
'────────────────────────────────────────────────────────────────────
' Now we know the first menu to display. Loop while the user hits
' the left or right arrow keys
'────────────────────────────────────────────────────────────────────
done% = FALSE
DO
'────────────────────────────────────────────────────────────────
' Calculate the longest menu entry in the list
'────────────────────────────────────────────────────────────────
longestEntry% = 0
FOR x% = 1 TO numEntries%(currentMenu%)
IF longestEntry% < LEN(menusArray$(currentMenu%, x%)) THEN
longestEntry% = LEN(menusArray$(currentMenu%, x%))
END IF
NEXT x%
'────────────────────────────────────────────────────────────────
' Calculate box dimensions
'────────────────────────────────────────────────────────────────
lft% = colCount% + 1
IF lft% < 1 THEN
lft% = 1
END IF
rght% = lft% + longestEntry% + 2
IF rght% > 78 THEN
lft% = lft% - (rght% - 78)
rght% = 78
END IF
top% = 2
bot% = top% + numEntries%(currentMenu%) + 1
'────────────────────────────────────────────────────────────────
' Save area of the screen that the window overwrites
'────────────────────────────────────────────────────────────────
REDIM blockArray%(BlockSize%(lft%, rght% + 2, top%, bot% + 1))
BlockSave lft%, rght% + 2, top%, bot% + 1, blockArray%(), GetVideoSegment
'────────────────────────────────────────────────────────────────
' Make the window to hold the entries
'────────────────────────────────────────────────────────────────
MakeWindow CSNG(top%), CSNG(lft%), CSNG(bot%), CSNG(rght%), fg%, bg%, 0, 0, shadowCode%, 0, ""
'────────────────────────────────────────────────────────────────
' Make the menu for the current menu
'────────────────────────────────────────────────────────────────
choice% = SubMenu%(menusArray$(), currentMenu%, numEntries%(currentMenu%), justify$, lft% + 2, rght% - 2, 3, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%)
'────────────────────────────────────────────────────────────────
' Decide what to do based on the returned value of the call to
' the SubMenu function, which handles the individual menus
'────────────────────────────────────────────────────────────────
SELECT CASE choice%
CASE LEFTARROWCODE ' Move to the next menu to the left
IF currentMenu% > 1 THEN
currentMenu% = currentMenu% - 1
ELSE
currentMenu% = numMenus%
END IF
CASE RIGHTARROWCODE ' Move to the next menu to the right
IF currentMenu% < numMenus% THEN
currentMenu% = currentMenu% + 1
ELSE
currentMenu% = 1
END IF
CASE 1 TO numEntries%(currentMenu%) ' See if an entry from the menu
menuEntrySelected% = choice% ' was selected
menuSelected% = currentMenu%
EXIT SUB
CASE 27 ' Escape ∙ Abort the menu
menuEntrySelected% = 0
menuSelected% = 0
done% = TRUE
CASE ELSE
END SELECT
'────────────────────────────────────────────────────────────────
' Update highlight
'────────────────────────────────────────────────────────────────
colCount% = 0
FOR x% = 1 TO oldMenu% - 1
colCount% = colCount% + LEN(menuTitles$(x%)) + 1
NEXT x%
LOCATE 1, 2 + colCount%, 0: DisplayEntry menuTitles$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
oldMenu% = currentMenu%
colCount% = 0
FOR x% = 1 TO currentMenu% - 1
colCount% = colCount% + LEN(menuTitles$(x%)) + 1
NEXT x%
LOCATE 1, 2 + colCount%, 0: DisplayEntry menuTitles$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
'────────────────────────────────────────────────────────────────
' Restore screen block
'────────────────────────────────────────────────────────────────
BlockRestore lft%, rght% + 2, top%, bot% + 1, blockArray%(), GetVideoSegment
LOOP UNTIL done%
END SUB
SUB OffCenter (st$, row%, leftCol%, rightCol%)
'┌────────────────────────────────────────────────────────────────────────┐
'│ This routine will center the text passed to it on the screen between │
'│ two specified columns. Excellent for centering text in a window │
'│ that itself is not centered in the screen. Parameters are: │
'│ │
'│ st$ - the string to center. Maximum length of string is 80 │
'│ characters. │
'│ row% - The row on which the string will be centered. Allowable │
'│ range is 1 through 25. │
'│ leftCol! - The left-most column to center the text between. │
'│ Allowable range is 1 through 79. │
'│ rightCol! - The right-most column to center the text between. │
'│ Allowable range is 2 through 80. │
'└────────────────────────────────────────────────────────────────────────┘
'─────────────────────────────────────────────────────────────────────────
' Calculate width available for string
'─────────────────────────────────────────────────────────────────────────
wdth% = (rightCol% - leftCol%)
'─────────────────────────────────────────────────────────────────────────
' If ST$ fits in available width, determine X% for Locate. Otherwise,
' quit the routine.
'─────────────────────────────────────────────────────────────────────────
IF LEN(st$) > wdth% THEN
EXIT SUB
ELSE
x% = INT(((wdth% - (LEN(st$))) \ 2) + leftCol%) + 1
END IF
'─────────────────────────────────────────────────────────────────────────
' Print the string
'─────────────────────────────────────────────────────────────────────────
LOCATE row%, x%: PRINT st$;
END SUB
SUB PutScreen (file$)
'┌──────────────────────────────────────────────────────────────────┐
'│ This subprogram will copy the contents of a file that was saved │
'│ using the QBSCR GetScreen subprogram (or Screen Builder)into │
'│ video RAM. The result is a very fast retrieval and display of │
'│ a video screen. │
'└──────────────────────────────────────────────────────────────────┘
'────────────────────────────────────────────────────────────────────
' Set the memory segment to the address of screen memory
'────────────────────────────────────────────────────────────────────
DEF SEG = GetVideoSegment
'────────────────────────────────────────────────────────────────────
' Use the BASIC BLOAD statement to load the saved screen to video RAM
'────────────────────────────────────────────────────────────────────
LOCATE 1, 1, 0
BLOAD file$, 0
'────────────────────────────────────────────────────────────────────
' Restore BASIC's default data segment
'────────────────────────────────────────────────────────────────────
DEF SEG
END SUB
SUB QBPrint (st$, row%, col%, fore%, back%)
'──────────────────────────────────────────────────────────────────────
' Calculate video memory offset, where display will begin
'──────────────────────────────────────────────────────────────────────
offset% = 160 * (row% - 1) + 2 * (col% - 1)
'──────────────────────────────────────────────────────────────────────
' Calculate color byte for string
'──────────────────────────────────────────────────────────────────────
IF fore% > 15 THEN
blinkingFore% = TRUE
fore% = fore% - 16
ELSE
blinkingFore% = FALSE
END IF
attribute% = (back% * 16) + fore%
IF blinkingFore% THEN
attribute% = attribute% + 128
END IF
'──────────────────────────────────────────────────────────────────────
' Set default data segment to screen memory
'──────────────────────────────────────────────────────────────────────
DEF SEG = GetVideoSegment
'──────────────────────────────────────────────────────────────────────
' Place the string into video memory, along with the color
'──────────────────────────────────────────────────────────────────────
stPos% = 1
FOR x% = 0 TO ((LEN(st$) - 1) * 2) STEP 2
POKE x% + offset%, ASC(MID$(st$, stPos%, 1))
POKE x% + offset% + 1, attribute%
stPos% = stPos% + 1
NEXT x%
'──────────────────────────────────────────────────────────────────────
' Restore BASIC's default data segment
'──────────────────────────────────────────────────────────────────────
DEF SEG
END SUB
FUNCTION ScreenBlank$ (delay)
'┌────────────────────────────────────────────────────────────────────────┐
'│ This routine blanks out the screen and displays a message informing │
'│ the user of this. To prevent this message from burning into the │
'│ screen, it changes place periodically. The Delay parameter is a │
'│ numerical variable used in a dummy wait loop. Change this value │
'│ based on the speed of your machine. This routine returns the key │
'│ the user pressed to restore the screen, in case you want to use it. │
'└────────────────────────────────────────────────────────────────────────┘
'─────────────────────────────────────────────────────────────────────────
' Seed the random number generator with the TIMER function
'─────────────────────────────────────────────────────────────────────────
RANDOMIZE TIMER
'─────────────────────────────────────────────────────────────────────────
' Initialize local variables, set colors and clear the screen
'─────────────────────────────────────────────────────────────────────────
blankCount = 0: key$ = "": COLOR 7, 0: CLS
'─────────────────────────────────────────────────────────────────────────
' Display the informational message
'─────────────────────────────────────────────────────────────────────────
GOSUB BounceMessage
'─────────────────────────────────────────────────────────────────────────
' While the user has not hit a key, increment our delay counter
'─────────────────────────────────────────────────────────────────────────
WHILE key$ = ""
key$ = INKEY$
blankCount = blankCount + 1
'─────────────────────────────────────────────────────────────────────
' If our counter reaches our delay, then move the screen message
'─────────────────────────────────────────────────────────────────────
IF blankCount > delay THEN
blankCount = 0: CLS
GOSUB BounceMessage
END IF
WEND
'─────────────────────────────────────────────────────────────────────────
' Assign the key hit to the function and exit
'─────────────────────────────────────────────────────────────────────────
ScreenBlank$ = key$
EXIT FUNCTION
'─────────────────────────────────────────────────────────────────────────
' This little subroutine moves the informational message to a new
' location on the screen
'─────────────────────────────────────────────────────────────────────────
BounceMessage:
'─────────────────────────────────────────────────────────────────────────
' Clear the screen
'─────────────────────────────────────────────────────────────────────────
CLS
'─────────────────────────────────────────────────────────────────────────
' Calculate new X and Y coordinates for the message randomly
'─────────────────────────────────────────────────────────────────────────
xCoord% = INT(RND(1) * 38) + 1
yCoord% = INT(RND(1) * 24) + 1
'─────────────────────────────────────────────────────────────────────────
' Display the message at the new X and Y coordinates
'─────────────────────────────────────────────────────────────────────────
LOCATE yCoord%, xCoord%, 0: PRINT "Screen has been blanked to prevent burn-in.";
LOCATE yCoord% + 1, xCoord%, 0: PRINT " Hit any key to return...";
'─────────────────────────────────────────────────────────────────────────
' Return to the wait loop
'─────────────────────────────────────────────────────────────────────────
RETURN
END FUNCTION
SUB ScrnRestore (firstLine%, lastLine%, scrArray%(), segment)
'┌────────────────────────────────────────────────────────────────────────┐
'│ This routine will restore all or a portion of the screen display from │
'│ an integer array. For more implementation details, see the QBSCR │
'│ reference manual. │
'│ │
'│ Parameters are as follows: │
'│ │
'│ firstLine% - The first line of the display where restore should │
'│ begin. Top line is 1, bottom is 25. │
'│ lastLine% - The last line of the display where restore should │
'│ end, LastLine% being included. │
'│ scrArray%() - The array in which the display contents will be │
'│ restored. Must be integer, and must be dimensioned │
'│ to 3999 (or 4000) elements. │
'└────────────────────────────────────────────────────────────────────────┘
'──────────────────────────────────────────────────────────────────────────
' Determine the starting address in the video memory (start%). Must use
' 160 for the length of a line, since an attribute byte is stored for each
' character on the screen (80 characters + 80 attributes = 160)
'──────────────────────────────────────────────────────────────────────────
start% = (firstLine% - 1) * 160
'──────────────────────────────────────────────────────────────────────────
' Calculate the length of the block of addresses we must restore (length%).
' 1 is subtracted since the array starts with element 0.
'──────────────────────────────────────────────────────────────────────────
length% = (((lastLine% - firstLine%) + 1) * 160) - 1
'──────────────────────────────────────────────────────────────────────────
' Set the default segment to the video memory segment.
'──────────────────────────────────────────────────────────────────────────
DEF SEG = segment
'──────────────────────────────────────────────────────────────────────────
' Restore information (characters and attributes) to video memory.
'──────────────────────────────────────────────────────────────────────────
FOR i% = 0 TO length%
POKE start% + i%, scrArray%(start% + i%)
NEXT i%
'──────────────────────────────────────────────────────────────────────────
' Restore default segment to BASIC's segment.
'──────────────────────────────────────────────────────────────────────────
DEF SEG
END SUB
SUB ScrnSave (firstLine%, lastLine%, scrArray%(), segment)
'┌────────────────────────────────────────────────────────────────────────┐
'│ This routine will save all or a portion of the screen display to an │
'│ integer array. For more implementation details, see the QBSCR │
'│ reference manual. │
'│ │
'│ Parameters are as follows: │
'│ │
'│ firstLine% - The first line of the display where saving should │
'│ begin. Top line is 1, bottom is 25. │
'│ lastLine% - The last line of the display where saving should │
'│ end, LastLine% being included. │
'│ scrArray%() - The array in which the display contents will be │
'│ stored. Must be integer, and must be dimensioned │
'│ to 3999 (or 4000) elements. │
'└────────────────────────────────────────────────────────────────────────┘
'──────────────────────────────────────────────────────────────────────────
' Determine the starting address in the video memory (start%). Must use
' 160 for the length of a line, since an attribute byte is stored for each
' character on the screen (80 characters + 80 attributes = 160)
'──────────────────────────────────────────────────────────────────────────
start% = (firstLine% - 1) * 160
'──────────────────────────────────────────────────────────────────────────
' Calculate the length of the block of addresses we must retrieve and
' store (length%). 1 is subtracted since the array starts with element 0.
'──────────────────────────────────────────────────────────────────────────
length% = (((lastLine% - firstLine%) + 1) * 160) - 1
'──────────────────────────────────────────────────────────────────────────
' Set the default segment to the video memory segment.
'──────────────────────────────────────────────────────────────────────────
DEF SEG = segment
'──────────────────────────────────────────────────────────────────────────
' Get information (characters and attributes) from video memory.
'──────────────────────────────────────────────────────────────────────────
FOR i% = 0 TO length%
scrArray%(start% + i%) = PEEK(start% + i%)
NEXT i%
'──────────────────────────────────────────────────────────────────────────
' Restore default segment to BASIC's segment.
'──────────────────────────────────────────────────────────────────────────
DEF SEG
END SUB
FUNCTION SubMenu% (choice$(), currentMenu%, numOfChoices%, justify$, leftColumn, rightColumn, row%, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%)
'┌───────────────────────────────────────────────────────────────────────┐
'│ This function is a special version of MakeMenu% and is used only by │
'│ the MultiMenu routine. It is not intended to be called by itself. │
'│ See the MakeMenu% function if you need a single menu, or want to │
'│ know more about the parameters of this function. │
'└───────────────────────────────────────────────────────────────────────┘
'─────────────────────────────────────────────────────────────────────────
' Set local variables - extended scan codes for keypad keys
'─────────────────────────────────────────────────────────────────────────
up$ = CHR$(0) + CHR$(72)
down$ = CHR$(0) + CHR$(80)
enter$ = CHR$(13)
home$ = CHR$(0) + CHR$(71)
end$ = CHR$(0) + CHR$(79)
pgUp$ = CHR$(0) + CHR$(73)
pgDn$ = CHR$(0) + CHR$(81)
leftArrow$ = CHR$(0) + CHR$(75)
rightArrow$ = CHR$(0) + CHR$(77)
'─────────────────────────────────────────────────────────────────────────
' Define the error tone string to use with PLAY
'─────────────────────────────────────────────────────────────────────────
errorTone$ = "MB T120 L50 O3 AF"
'─────────────────────────────────────────────────────────────────────────
' Set type of justification to uppercase
'─────────────────────────────────────────────────────────────────────────
justify$ = UCASE$(justify$)
wdth% = (rightColumn - leftColumn - 1)
'─────────────────────────────────────────────────────────────────────────
' Check for out-of-bounds parameters. If any are out of range,
' quit the function
'─────────────────────────────────────────────────────────────────────────
IF justify$ <> "C" AND justify$ <> "L" AND justify$ <> "R" THEN EXIT FUNCTION
IF leftColumn < 1 OR rightColumn > 80 THEN EXIT FUNCTION
IF row% < 1 OR row% > 24 THEN EXIT FUNCTION
'─────────────────────────────────────────────────────────────────────────
' Calculate the array of character identifiers
'─────────────────────────────────────────────────────────────────────────
REDIM charID(numOfChoices%) AS STRING * 1
FOR x% = 1 TO numOfChoices%
FOR y% = 1 TO LEN(choice$(currentMenu%, x%))
IF MID$(choice$(currentMenu%, x%), y%, 1) = marker$ THEN
charID(x%) = UCASE$(MID$(choice$(currentMenu%, x%), y% + 1, 1))
EXIT FOR
END IF
NEXT y%
NEXT x%
'─────────────────────────────────────────────────────────────────────────
' Calculate length of longest menu choice and store value in ChoiceLen%
'─────────────────────────────────────────────────────────────────────────
choiceLen% = 0
FOR x% = 1 TO numOfChoices%
IF LEN(choice$(currentMenu%, x%)) > choiceLen% THEN
choiceLen% = LEN(choice$(currentMenu%, x%))
END IF
NEXT x%
choiceLen% = choiceLen% - 1
'─────────────────────────────────────────────────────────────────────────
' Determine left-most column to display highlight bar on
'─────────────────────────────────────────────────────────────────────────
col = (((rightColumn - leftColumn - 1) - choiceLen%) / 2) + leftColumn
'─────────────────────────────────────────────────────────────────────────
' Print menu choices to screen based on the type of Justification
' selected (Center, Left, Right).
'─────────────────────────────────────────────────────────────────────────
COLOR fg%, bg%
SELECT CASE justify$
CASE "C"
FOR x% = 1 TO numOfChoices%
xCol% = ((wdth% - (LEN(choice$(currentMenu%, x%))) - 1) \ 2 + leftColumn) + 1
LOCATE (row% - 1) + x%, leftColumn - 1, 0
PRINT SPACE$(choiceLen% + 2);
LOCATE (row% - 1) + x%, xCol%, 0
DisplayEntry choice$(currentMenu%, x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
NEXT x%
CASE "R"
FOR x% = 1 TO numOfChoices%
LOCATE (row% - 1) + x%, leftColumn - 1, 0
PRINT SPACE$(choiceLen% + 2);
LOCATE (row% - 1) + x%, (rightColumn - LEN(choice$(currentMenu%, x%)))
DisplayEntry choice$(currentMenu%, x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
NEXT x%
CASE "L"
FOR x% = 1 TO numOfChoices%
LOCATE (row% - 1) + x%, leftColumn - 1, 0
PRINT SPACE$(choiceLen% + 2);
LOCATE (row% - 1) + x%, leftColumn, 0
DisplayEntry choice$(currentMenu%, x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
NEXT x%
END SELECT
'─────────────────────────────────────────────────────────────────────────
' Highlight the first entry in the list. Must take into account the
' justification type.
'─────────────────────────────────────────────────────────────────────────
currentLocation% = 1
COLOR hfg%, hbg%
LOCATE row%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
SELECT CASE justify$
CASE "C"
xCol% = ((wdth% - (LEN(choice$(currentMenu%, currentLocation%))) - 1) \ 2 + leftColumn) + 1
LOCATE (row% - 1 + currentLocation%), xCol%, 0
DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
CASE "R"
LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentMenu%, currentLocation%)))
DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
CASE "L"
LOCATE (row% - 1) + currentLocation%, leftColumn
DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
END SELECT
'─────────────────────────────────────────────────────────────────────────
' Read keystrokes and change the highlighted entry appropriately
'─────────────────────────────────────────────────────────────────────────
exitCode = FALSE
WHILE exitCode = FALSE
'─────────────────────────────────────────────────────────────────────
' Read keystrokes
'─────────────────────────────────────────────────────────────────────
key$ = ""
WHILE key$ = ""
LET key$ = UCASE$(INKEY$)
WEND
SELECT CASE key$
CASE up$, down$, home$, end$, pgUp$, pgDn$ '=== Legal movement
'─────────────────────────────────────────────────────────────
' Restore old highlighted choice to normal colors
'─────────────────────────────────────────────────────────────
COLOR fg%, bg%
LOCATE (row% - 1) + currentLocation%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
SELECT CASE justify$
CASE "C"
xCol% = ((wdth% - (LEN(choice$(currentMenu%, currentLocation%))) - 1) \ 2 + leftColumn) + 1
LOCATE (row% - 1 + currentLocation%), xCol%, 0
DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
CASE "R"
LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentMenu%, currentLocation%)))
DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
CASE "L"
LOCATE (row% - 1) + currentLocation%, leftColumn, 0
DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
END SELECT
CASE leftArrow$
SubMenu% = LEFTARROWCODE
EXIT FUNCTION
CASE rightArrow$
SubMenu% = RIGHTARROWCODE
EXIT FUNCTION
CASE CHR$(32) TO CHR$(127) 'If valid KEY code, then restore old entry
FOR x% = 1 TO numOfChoices%
IF key$ = charID(x%) THEN
COLOR fg%, bg%
LOCATE (row% - 1) + currentLocation%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
SELECT CASE justify$
CASE "C"
xCol% = ((wdth% - (LEN(choice$(currentMenu%, currentLocation%))) - 1) \ 2 + leftColumn) + 1
LOCATE (row% - 1 + currentLocation%), xCol%, 0
DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
EXIT FOR
CASE "R"
LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentMenu%, currentLocation%)))
DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
EXIT FOR
CASE "L"
LOCATE (row% - 1) + currentLocation%, leftColumn, 0
DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
EXIT FOR
END SELECT
END IF
NEXT x%
CASE CHR$(27) ' The ESC key
SubMenu% = 27
EXIT FUNCTION
CASE ELSE
'Nuthin!
END SELECT
'─────────────────────────────────────────────────────────────────────
' Update our highlight bar's location based on which key was hit
'─────────────────────────────────────────────────────────────────────
SELECT CASE key$
CASE up$
'─────────────────────────────────────────────────────────────
' Set new currentLocation%
'─────────────────────────────────────────────────────────────
IF currentLocation% = 1 THEN
currentLocation% = numOfChoices%
ELSE
currentLocation% = currentLocation% - 1
END IF
CASE down$
'─────────────────────────────────────────────────────────────
' Set New currentLocation%
'─────────────────────────────────────────────────────────────
IF currentLocation% = numOfChoices% THEN
currentLocation% = 1
ELSE
currentLocation% = currentLocation% + 1
END IF
CASE enter$
'─────────────────────────────────────────────────────────────
' Set MakeMenu to highlighted selection and exit
'─────────────────────────────────────────────────────────────
SubMenu% = currentLocation%
'─────────────────────────────────────────────────────────────
' Instead of using exitCode to beak out of this, we have to
' use EXIT FUNCTION, or it never quits.
'─────────────────────────────────────────────────────────────
EXIT FUNCTION
CASE home$, pgUp$
'─────────────────────────────────────────────────────────────
' Set New currentLocation%
'─────────────────────────────────────────────────────────────
currentLocation% = 1
CASE end$, pgDn$
'─────────────────────────────────────────────────────────────
' Set New currentLocation%
'─────────────────────────────────────────────────────────────
currentLocation% = numOfChoices%
CASE CHR$(32) TO CHR$(127)
'─────────────────────────────────────────────────────────────
' Check for "Quick Access" codes
'─────────────────────────────────────────────────────────────
validEntry% = FALSE
FOR x% = 1 TO numOfChoices%
IF key$ = charID(x%) THEN
SubMenu% = x%
currentLocation% = x%
validEntry% = TRUE
END IF
NEXT x%
IF validEntry% = FALSE THEN
PLAY errorTone$
END IF
CASE ELSE
'─────────────────────────────────────────────────────────────
' Play Error Tone - change this around if your don't like it
'─────────────────────────────────────────────────────────────
PLAY errorTone$
END SELECT
'─────────────────────────────────────────────────────────────────────
' Highlight the entry indicated by CurrentLocation%
'─────────────────────────────────────────────────────────────────────
SELECT CASE key$
CASE up$, down$, home$, end$, pgUp$, pgDn$
'─────────────────────────────────────────────────────────────
' Highlight new choice
'─────────────────────────────────────────────────────────────
COLOR hfg%, hbg%
LOCATE (row% - 1) + currentLocation%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
SELECT CASE justify$
CASE "C"
xCol% = ((wdth% - (LEN(choice$(currentMenu%, currentLocation%))) - 1) \ 2 + leftColumn) + 1
LOCATE (row% - 1 + currentLocation%), xCol%, 0
DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
CASE "R"
LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentMenu%, currentLocation%)))
DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
CASE "L"
LOCATE (row% - 1) + currentLocation%, leftColumn, 0
DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
END SELECT
CASE CHR$(32) TO CHR$(127)
FOR x% = 1 TO numOfChoices%
IF key$ = charID(x%) THEN
'─────────────────────────────────────────────────────
' Highlight new choice
'─────────────────────────────────────────────────────
COLOR hfg%, hbg%
LOCATE (row% - 1) + currentLocation%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
SELECT CASE justify$
CASE "C"
xCol% = ((wdth% - (LEN(choice$(currentMenu%, currentLocation%))) - 1) \ 2 + leftColumn) + 1
LOCATE (row% - 1 + currentLocation%), xCol%, 0
DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
EXIT FUNCTION
CASE "R"
LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentMenu%, currentLocation%)))
DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
EXIT FUNCTION
CASE "L"
LOCATE (row% - 1) + currentLocation%, leftColumn, 0
DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
EXIT FUNCTION
END SELECT
END IF
NEXT x%
CASE ELSE
'Nuthin!
END SELECT
WEND
END FUNCTION
SUB Wipe (top%, bottom%, lft%, rght%, back%)
'┌────────────────────────────────────────────────────────────────────────┐
'│ This routine clears off a selected portion of the screen. Note that │
'│ the area cleared by this routine is always INSIDE the box defined by │
'│ coordinates passed in. This allows you to use the same values used │
'│ for the window being WIPEd, without having to adjust them by one to │
'│ avoid erasing your window border. │
'│ The passed parameters are: │
'│ │
'│ top% - The top-most row to clear. Allowable range is 1 to 25. │
'│ bottom% - The bottom-most row to clear. Allowable range is │
'│ 1 to 25. │
'│ lft% - The left-most column to clear. Allowable range is 1 to │
'│ 80. │
'│ rght% - The right-most column to clear. Allowable range is │
'│ 1 to 80. │
'│ back% - The background color to clear with. Allowable range is │
'│ 0 to 7. │
'└────────────────────────────────────────────────────────────────────────┘
'─────────────────────────────────────────────────────────────────────────
' Change to the passed background color
'─────────────────────────────────────────────────────────────────────────
COLOR , back%
'─────────────────────────────────────────────────────────────────────────
' Clear the selected portion of the screen by overwriting with spaces
'─────────────────────────────────────────────────────────────────────────
FOR x% = top% + 1 TO bottom% - 1
LOCATE x%, lft% + 1, 0
PRINT SPACE$(rght% - lft% - 1);
NEXT x%
END SUB